د.كاف يار

انت بهذه الطريقة استغنيت عنها و اخذت اكبر قيمة في الجدول الآخر الذي تريد ترحيل البيانات اليه

عفوا هل السيرفر داخلي أم خارجي على استضافة

تفضل هذه الفكرة 1678743215_.accdb R_RECEIVING.pdf

بإمكانك حذفها لكن ماهو المطلوب ؟ ما هي المشكلة التي تواجهك ؟

تصميم جميل و احترافي مشاء الله لا قوة إلا بالله

لمعرفة المخزون بشكل عام استخدم الكود التالي Nz(DSum("Quantity_Store", "Store", "[Drug_ID] Like '*" & Drug_ID & "*'"), 0) لمعرفة اجمالي المصروف Nz(DSum("Quantity", "Dispensing", "[Drug_ID] Like '*" & Drug_ID & "*'"), 0) بالإمكان خصم قيمة المخزون من قيمة الصرف لتحصل على صافي المخزون

مشاركة مع الإخوة تجربة.accdb لكي تستخدم الشرط في الاستعلام يجب ان يكون كذ IIF

تفضل strSQL = "INSERT INTO clients ( [no], name, notice ) IN '" & txtPath & "'" & _ " SELECT Nz(Dmax('[no]','clients'),0)+1, clients.name, clients.notice FROM clients"

ارفق رابط المشاركة المعنية

@hassansaat تعلم الاستيراد بكل سهولة في البداية قم بإستدعاء مكتبة الإكسل الآن نقوم بإنشاء Module جديد و اضافة الكود التالي Public filenname As String Public Function importExcel(tablename As String) As String ', filenname As String Dim xlApp As Excel.Application Dim xlWb As Excel.Workbook Dim xlWs As Excel.Worksheet Dim intLine As Long Dim strSqlDml As String Dim strColumn1 As String, strColumn2 As String, strColumn3 As String varfile = filenname CurrentDb.Execute "DELETE * FROM List", dbFailOnError Set xlApp = New Excel.Application xlApp.Visible = False Set xlWb = xlApp.Workbooks.Open(varfile) Set xlWs = xlWb.Worksheets(1) intLine = 2 Do strColumn1 = Trim(xlWs.Cells(intLine, 1).Value) strColumn2 = Trim(xlWs.Cells(intLine, 2).Value) strColumn3 = Trim(xlWs.Cells(intLine, 3).Value) strSqlDml = "INSERT INTO List VALUES('" & strColumn1 & "', '" & strColumn2 & "', '" & strColumn3 & "')" CurrentDb.Execute strSqlDml, dbFailOnError xlWs.Cells(intLine, 1).Select intLine = intLine + 1 Loop Until IsEmpty(xlWs.Cells(intLine, 1)) xlWb.Close False xlApp.Quit Set xlApp = Nothing Set xlWb = Nothing Set xlWs = Nothing filenname = "" End Function Public Sub SelectFiles() Dim Addfile As Object Set Addfile = Application.FileDialog(3) With Addfile .AllowMultiSelect = False .InitialFileName = "" .Filters.Clear .Filters.Add "Excel Files", "*.xls,*.xlsx" If .Show = True Then filenname = Trim(.SelectedItems(1)) Else Exit Sub End If End With End Sub شرح مختصر للكود نقوم بالإعلان عن متغييرات تحمل اسماء مستعارة للأعمدة في ملف الإكسل مثلا strColumn1 -strColumn2 - strColumn3 Dim strColumn1 As String, strColumn2 As String, strColumn3 As String الأن نقوم بتعريف المتغييرات على الأعمدة في ملف الأكسل من خلال التعريف xlWs.Cells(intLine, 1).Value حيث أن رقم 1 هو العمود رقم 1 في الاكسل و هكذا strColumn1 = Trim(xlWs.Cells(intLine, 1).Value) strColumn2 = Trim(xlWs.Cells(intLine, 2).Value) strColumn3 = Trim(xlWs.Cells(intLine, 3).Value) تفضل التعديل Access-Import.accdb

ممتاز فعلا افضل حل و بإحترافية تامة

اخي هل انت متمسك جدا بالكود ؟ بالإمكان جعل الكود اسهل في الاستخدام و التعامل مماهو عليه الآن و بنفس تصميم النموذج الحالي فقط اقوم بتغيير الكود هل توافق ؟

تفضل هذا التعديل transport.accdb

تفضل اسم التقرير Report1 تم التجميع على حسب المنطقة و المجموعة transport.accdb

تفضل هذا التعديل لكن يلزمك اضافة عمود لكلمة المرور و كذلك اضافة فورم لعملية اختيار ملف قاعدة البيانات بحيث يكون بجوار كل مسار كلمة المرور الخاصة بكل قاعدة بيانات يتم اضافتها تم اضافة الفكرة للمجلد الأول فقط لأن طلبك يحتاج الى تعديلات كثيرة مثل اضافة بعض الاعمدة في الجداول و كذلك فوم لإختيار قاعدة البيانات نصيحتي لك ان تستخدم الطرق السهلة لكي تستطيع التعامل معها اختيار الطرق الصعبة ماهي الا مضيعة للوقت تفضل التعديل فقط على اول جزئية للمجلد baksw كرر نفس الطريقة لباقي المجلدات و لكن بعد التعديل على الجداول لديك بما يتوافق مع اسلوب كلمة المرور لديك sswd.zip

كيف تعرف ان الطالب في الفترة الصباحية او المسائية ؟ ففي المجموعة الواحدة يومين و يتم تخصيص للطالب مجموعة واحدة فقط فهذه المجموعة ماهي ؟ هل هي صباحية ؟ أم هل هي مسائية ؟

في محرر الأكواد

تفضل التعديل حساب عدد الورديات والساعات حسب التاريخ.zip

طيب اتفضل هذا التعديل حساب عدد الورديات والساعات حسب التاريخ.zip

تفضل ضع هذا الكود في ازرار انشاء نسخة احتياطية On Error GoTo ErrH Dim fso As Object Dim fldrname As String Dim fldrpath As String Set fso = CreateObject("scripting.filesystemobject") fldrpath = CurrentProject.Path & "\Backup" If Not fso.FolderExists(fldrpath) Then fso.createfolder (fldrpath) DoCmd.RunSQL "CREATE TABLE Backup (Backup_NO INT , Backup_Name VARCHAR (50) , Backup_Path VARCHAR (100), Backup_Date Date);" End If Dim MyFile, DstFile As String Dim Syso As Object MyFile = CurrentProject.FullName DstFile = CurrentProject.Path & "\Backup\Backup-" & Format(Now, "dd-mm-yyyy") & "-" & Format(Now, "hh-nn-ss") & ".accdb" DBEngine.Idle Set Syso = CreateObject("Scripting.FileSystemObject") Syso.copyfile MyFile, DstFile Set Syso = Nothing Name DstFile As DstFile & ".ptc" DBEngine.CompactDatabase DstFile & ".ptc", DstFile Kill DstFile & ".ptc" Dim db As DAO.Database Dim MaxBackup_NO As Integer MaxBackup_NO = Nz(DMax("[Backup_NO]", "[Backup]"), 0) + 1 Dim rs As DAO.Recordset Set db = CurrentDb Set rs = db.OpenRecordset("Backup") With rs .AddNew ![Backup_NO] = MaxBackup_NO ![Backup_Name] = Format(Now, "dd-mm-yyyy") & "-" & Format(Now, "hh-nn-ss") ![Backup_Path] = DstFile ![Backup_Date] = Now() .Update End With rs.Close Set rs = Nothing MsgBox "تم انشاء قاعدة البيانات بنجاح" & vbNewLine & "Database successfully created" & vbNewLine & vbNewLine & "" & "اسم قاعدة البيانات" & vbNewLine & "The name of the database" & vbNewLine & "" & vbNewLine & "Backup-" & Format(Date, "dd-mm-yyyy") & vbNewLine & vbNewLine & "" & "مسار القاعدة الجديدة" & vbNewLine & "Path of the new rule" & vbNewLine & "" & vbNewLine & DstFile, vbMsgBoxRight + vbOKOnly, "emphasis" & "/" & "تاكيد" Exit Sub ErrH: Select Case Err.Number End Select

تفضل التعديل حساب عدد الورديات والساعات حسب التاريخ.zip

تفضل هذا الحل بالإمكان تغيير وقت الإنصراف من خلال الكود نهاية الدوام الساعة 8 صباحا و بعدها سيتم حساب يوم جديد Public Function Overtime(RealCheckoutTime As Date, CheckoutTime As Date) Select Case CheckoutTime Case #1:00:00 AM# To #8:00:00 AM# Overtime = DateDiff("h", DateAdd("d", -1, RealCheckoutTime), CheckoutTime) Case Is > RealCheckoutTime Overtime = DateDiff("h", RealCheckoutTime, CheckoutTime) Case lese Overtime = 0 End Select End Function New Microsoft Access Database.accdb

تفضل التعديل ملاحظة اعادة الترقيم سوف تسبب لك مشكلة كبيرة في الجداول الفرعة لذا يجب عليك عمل نسخة احتياطية قبل البدء و يجب ان تعلم انك ستفقد ارتباط الجداول الأخرى بالجدول الرئيسي لأن مفتاح السجل الرئيسي سيتم تغييره و لن يتعرف على البيانات الخاصة به في الجداول الأخرى تفضل التعديل mr.zip

تفضل جرب Nz(DSum("[Loan_Payment]", "[tbl_Loans]", "Format([Loan_AwardMonth],'yyyy') Like '*" & Me.txtYear & "*' And [Loan_Type] Like 'Cridi'"), 0)

استخدم هذا