Foksh

وعليكم السلام ورحمة الله وبركاته ..
تفضل أخي الكريم ، هذا مثال ، ولكن في المرات القادمة حاول ارفاق ملف من واقع مشروعك ، حتى لا ندخل في متاهة اختلاف الجداول بتصميمها وفكرة انني لم اعرف تطبيق الفكرة على مشروعي ...... الخ 
 
Tost.accdb

وعليكم السلام ورحمة الله وبركاته ,,
تفضل يا صديقي :-
Private Function OpenDatabaseAndQuit(dbName As String) Dim currentPath As String Dim dbPath As String currentPath = Left(CurrentDb.Name, InStrRev(CurrentDb.Name, "\")) dbPath = currentPath & dbName & ".mdb" Shell "cmd /c start " & dbPath, vbHide Application.Quit End Function Private Sub أمر22_Click() OpenDatabaseAndQuit "A" End Sub Private Sub أمر3_Click() OpenDatabaseAndQuit "B" End Sub  
الملف بعد التعديل 
Data.zip

تم التنفيذ سابقاً ، وهذا المرفق مصور لما تم تطبيقه
control2025.accdb
 

وعليكم السلام ورحمة الله وبركاته ..
اجعل هذا الاستعلام مصدر سجلات النموذج
SELECT tbnum.id, tbnum.numx, IIF(tbnum.numx - INT(tbnum.numx) > 0, 'A', 'B') AS resultx FROM tbnum;  

المشكلة يا صديقي انه عند اختيار "All Rooms" من الكومبوبوكس cboRoomNumber ، فإن الشرط في جملة WHERE يصبح :
WHERE Transactions.RoomNumber = "All Rooms" ولا اعتقد انه عندك غرفة بهذا الاسم أو الرقم ، صحيح ؟؟
لازم تعديل الشرط بحيث إذا كان قيمة الكومبوبوكس cboRoomNumber تساوي "All Rooms" يتم تجاهل شرط رقم الغرفة، أي يتم عرض جميع الغرف بحيث يصبح الاستعلام هكذا :-
SELECT Transactions.RoomNumber, [FirstName] & " " & [LastName] AS Name, [DateIn] & " - " & [DateOut] AS [Date], Transactions.Days, Transactions.AmountPaid, Transactions.DateIn, Transactions.DateOut FROM Transactions INNER JOIN Customers ON Transactions.CustomerID = Customers.CustomerID WHERE (([Forms]![frmRPTRoomHistory]![cboRoomNumber] = 'All Rooms') OR (Transactions.RoomNumber = [Forms]![frmRPTRoomHistory]![cboRoomNumber])) AND ((Transactions.DateIn) Between [Forms]![frmRPTRoomHistory]![dtpCheckIn] And [Forms]![frmRPTRoomHistory]![dtpCheckout]); في المرفق التالي ، تم انشاء استعلام جديد وجعله مصدر سجلات التقرير للتجربة ..
Microsoft Access قاعدة بيانات جديد ‫(2)‬.accdb

جرب التعديل التالي :-
DoCmd.RunSQL "INSERT INTO tbl_note_administrative (num,nom_arabe,prenom_arabe, date_naissance, lieu_naissance, wilaya_naissance, situation_familiale,nombre_enfant,grade_poste_actuel,sifa,grade,date_effet_grade_actuel,loi_fondamontale,situation_poste_travail,classement_liste, annet, nom_poste, situation_special )" & vbCrLf & _ "SELECT tbl_info_fonctionnaire.num, tbl_info_fonctionnaire.nom_arabe, tbl_info_fonctionnaire.prenom_arabe, tbl_info_fonctionnaire.date_naissance, tbl_info_fonctionnaire.lieu_naissance, tbl_info_fonctionnaire.wilaya_naissance, tbl_info_fonctionnaire.situation_familiale,tbl_info_fonctionnaire.nombre_enfant,tbl_info_fonctionnaire.grade_poste_actuel,tbl_info_fonctionnaire.sifa,tbl_info_fonctionnaire.grade,tbl_info_fonctionnaire.date_effet_grade_actuel,tbl_info_fonctionnaire.loi_fondamontale,tbl_info_fonctionnaire.situation_poste_travail,tbl_info_fonctionnaire.classement_liste, [forms]![frm_AddMonth]![annet1] AS Expr4, tbl_poste_superieur.nom_poste, tbl_situation_juridique_mouv.situation_special " & vbCrLf & _ "FROM (tbl_info_fonctionnaire LEFT JOIN tbl_poste_superieur ON tbl_info_fonctionnaire.num = tbl_poste_superieur.code_fonct) " & vbCrLf & _ "INNER JOIN tbl_situation_juridique_mouv ON tbl_info_fonctionnaire.num = tbl_situation_juridique_mouv.code_fonct " & vbCrLf & _ "WHERE tbl_info_fonctionnaire.situation_poste_travail = 'موظف';"  

جرب هذا التعديل ..
Private Sub cmd_Pay_installments_Click() On Error GoTo err_cmd_Pay_installments_Click ' ..........................الشطر الاول اقتطاع القروض والكهرومنزلية Dim rst As DAO.Recordset 'Cridi and Elec Payments Set rst = CurrentDb.OpenRecordset("Select * From tbl_Loans Where [Payment_Month]=CDATE('" & Me.txtMonth & "')") rst.MoveLast: rst.MoveFirst Rc = rst.RecordCount a1 = 0 'just a flag a2 = 0 'just a flag If Rc = 0 Then MsgBox " لا توجد إقتطاعات لشهر " & Format(Me.txtMonth, "mmmm") & " " & Year(Me.txtMonth), vbInformation Exit Sub End If If Len(rst!Payment_Made & "") = 0 And Not IsNull(rst!Loan_Made) Then Select Case MsgBox("هل تريد أن يتم توزيع الإقتطاعات لشهر " & Me.txtMonth, vbYesNo + vbQuestion + vbDefaultButton1) Case vbYes For i = 1 To Rc rst.Edit If rst!Nr >= 6 Then rst!Payment_Made = 0# Else If rst!Loan_Type = "Cridi" Then rst!Payment_Made = rst!Loan_Made rst!sadad = rst!Loan_Made rst!Loan_Remise = 0 End If If rst!Loan_Type = "Elec" Then rst!Payment_Made = rst!Loan_Made rst!sadad = rst!Loan_Made rst!Loan_Remise = 0 End If End If If rst!sadad.Value = True Then rst!wada3 = "تم التسديد" Else rst!wada3 = "لم يتم التسديد" End If TheSum = TheSum + Nz(rst!Payment_Made, 0) rst.Update rst.MoveNext Next i ' .......................... الشطر الثاني اقتطاع الانخراط 'Other loans for March (3) and July (7) If Month(Now()) = 3 Or Month(Now()) = 7 Then Dim rstE As DAO.Recordset Set rst = CurrentDb.OpenRecordset("Select * From tbl_Loans") myCriteria = "([detach]='موظف'" myCriteria = myCriteria & " Or [detach]='عامل متعاقد توقيت كامل'" myCriteria = myCriteria & " Or [detach]='عامل متعاقد توقيت جزئي'" myCriteria = myCriteria & " Or [detach]='حارس متعاقد توقيت جزئي'" myCriteria = myCriteria & " Or [detach]='عون نظافه وتطهير')" Set rstE = CurrentDb.OpenRecordset("Select * From Employee Where " & myCriteria) rstE.MoveLast: rstE.MoveFirst Rc = rstE.RecordCount For i = 1 To Rc If Month(Now()) = 3 Then If Nz(DLookup("Payment_Made", "tbl_Loans", "EmployeeID=" & rstE!EmployeeID & _ " And [Payment_Made]=3000 And [Payment_Month] Between #1/1/" & Year(Now()) & "# And #2/28/" & Year(Now()) & "#"), 0) = 3000 Then rstE.MoveNext GoTo NextEmployee End If End If If Month(Now()) = 7 Then If Nz(DLookup("Payment_Made", "tbl_Loans", "EmployeeID=" & rstE!EmployeeID & _ " And [Payment_Made]=3000 And [Payment_Month] Between #4/1/" & Year(Now()) & "# And #6/30/" & Year(Now()) & "#"), 0) = 3000 Then rstE.MoveNext GoTo NextEmployee End If End If rst.FindFirst "[Loan_Type]='Inkhirat' And [EmployeeID]=" & rstE!EmployeeID & " And [Payment_Month]=#" & Me.txtMonth & "#" If rst.NoMatch Then rst.AddNew a2 = 1 rst!EmployeeID = rstE!EmployeeID rst!Loan_ID = 0 rst!Payment_Month = DateSerial(Year(Me.txtMonth), Month(Me.txtMonth), 1) rst!Payment_Made = DLookup("Other_Value", "TblOther", "ID=1") rst!Loan_Type = "Inkhirat" rst!Nr = GetNumDetach(rst!EmployeeID) rst!Remarks = "إقتطاع من الراتب لإنخراط شهر " & Year(Me.txtMonth) & "/" & Month(Me.txtMonth) rst!annee = Year(Date) If rst!Loan_Type = "Inkhirat" Then rst!sadad = rst!Payment_Made If rst!sadad.Value = True Then rst!wada3 = "تم الإنخراط" Else rst!wada3 = "لم يتم الإنخراط" End If End If TheSum = TheSum + Nz(rst!Payment_Made, 0) rst.Update NextEmployee: rstE.MoveNext Next i rstE.Close: Set rstE = Nothing End If TheSum = Format(TheSum, "#,##0.00") MsgBox " " & "تم توزيع الإقتطاعات" & vbLf & vbLf & "مجموع الإقتطاعات = " & TheSum, , "إقتطاعات شهر" & FrenchMonth(Month(Date)) & Year(Date) I_am_Done: Case vbNo MsgBox "لم يتم توزيع الإقتطاعات" End Select rst.Close: Set rst = Nothing End If Exit Sub err_cmd_Pay_installments_Click: If Err.Number = 3021 Then Resume Next Else MsgBox Err.Number & vbCrLf & Err.Description End If End Sub  

اذا ، جرب الكود التالي :-
Private Sub Command137_Click() On Error GoTo ErrorHandler Dim db As DAO.Database Dim newID As Long Dim oldID As Long Dim newINVNo As Long If IsNull(Me.id) Then Exit Sub Set db = CurrentDb oldID = Me.id newINVNo = Nz(DMax("[INVNo]", "HTable"), 3000) + 1 db.Execute "INSERT INTO HTable " & _ "([INVNo], [Fdate], [compcode], [comName], [TaxId], [Note]) " & _ "SELECT " & newINVNo & ", Fdate, compcode, comName, TaxId, Note " & _ "FROM HTable WHERE ID = " & oldID newID = DMax("ID", "HTable") db.Execute "INSERT INTO Irsal " & _ "(IDNO, SenfNO, senfname, NetWight, price, Total) " & _ "SELECT " & newID & ", SenfNO, senfname, NetWight, price, Total " & _ "FROM Irsal " & _ "WHERE IDNO = " & oldID Me.Requery Me.RecordsetClone.FindFirst "ID = " & newID Me.Bookmark = Me.RecordsetClone.Bookmark ExitHere: Set db = Nothing Exit Sub ErrorHandler: MsgBox Err.Description & vbNewLine & _ "رقم الخطأ: " & Err.Number, vbCritical Resume ExitHere End Sub  
60000.accdb

هل هذا ما تقصده ؟؟
جرب سجل الدخول بأي اسم مستشفى ، ستلاحظ انشاء مجلد خاص باسم المستشفى بجانب قاعدة ..
inv4.accdb

اعتقد انك كررت طلبك ولكن بتغيير النموذج وأشياء بسيطة ..
لكن تفضل هذا طلبك بطريقة بدائية بسيطة
 
test.accdb

بما أنني شاركت في متابعة سابقة لنفس الموضوع ،جرب هذا الكود في زر التوزيع ,,
Private Sub أمر604_Click() On Error Resume Next If IsNull(Me.grop) Then MsgBox "من فضلك اكتب عدد المجموعة", vbCritical Exit Sub End If If IsNull(Me.go11) Then MsgBox "من فضلك اكتب بداية رقم الجلوس", vbCritical Exit Sub End If If IsNull(Me.Se1) Then MsgBox "من فضلك اكتب بداية رقم السرى", vbCritical Exit Sub End If If IsNull(Me.mg_grop) Then MsgBox "من فضلك اكتب رقم المجموعة", vbCritical Exit Sub End If If IsNull(Me.tr_sry) Then MsgBox "من فضلك اختر طريقة التوزيع", vbCritical Exit Sub End If Dim k As Integer Dim rs As DAO.Recordset If DCount("[num_Glos]", "[data]", "[num_Glos] Between " & [Forms]![sry_trm1]![go11] & " AND " & [Forms]![sry_trm1]![go22] & " And [sery] Is Not Null") > 0 Then MsgBox "انتبه : تم ادخال ارقام الجلوس هذه سابقا", vbCritical ElseIf DCount("[sery_name]", "[data]", "[sery_name] = " & [Forms]![sry_trm1]![mg_grop] & "") > 0 Then MsgBox "انتبه : تم ادخال رقم هذه المجموعة سابقا", vbCritical ElseIf DCount("[sery]", "[data]", "[sery] Between " & [Forms]![sry_trm1]![Se1] & " AND " & [Forms]![sry_trm1]![Se2] & "") > 0 Then MsgBox "انتبه : هناك ارقام سرية متداخلة", vbCritical Exit Sub Else Set rs = CurrentDb.OpenRecordset("SELECT data.name_student, data.num_Glos, data.CLASS_CLASS, data.sery, data.sery_name FROM data WHERE data.num_Glos Between " & [Forms]![sry_trm1]![go11] & " And " & [Forms]![sry_trm1]![go22] & ";") k = Me.Se1 With rs .MoveLast .MoveFirst For i = 1 To .RecordCount .Edit rs!sery = k rs!sery_name = Me.mg_grop .Update If Me.tr_sry = "زائد واحد" Then k = k + 1 ElseIf Me.tr_sry = "ناقص واحد" Then k = k - 1 End If .MoveNext Next i End With MsgBox "تم بنجاح توزيع وادخال الأرقام السرية للمجموعة رقم " & Me.mg_grop, vbInformation Me.Requery Me.Se1 = "" Me.go11 = "" Me.mg_grop = "" Me.grop = "" End If End Sub  
المرفق بعد التعديل :-
توزيع اللجان والسرى.accdb

بالعكس  الحقل يظهر ، لكن المشكلة واعتقد انها بسبب فرق اصدار الأوفيس ، أن قيم الحقل = نعم / لا على عكس الحقل الذي قمت انا بإضافته لتمييز السجلات التي تم استرجاعها .
على العموم ، تفضل هذا المرفق يا صديقي بعد التعديلات التي طلبتها ..
في نموذج الاسترجاع تم حذف الأجزاء المتعلقة بالحذف للفواتير التي مضى عليها شهر ، واعتماد فكرة مربع النص والمسار ، لكنني طبعاً لم أقم بضم مربع النص للجدول الجديد وتركت لك حرية الأمر ..
كود الترحيل ( التصدير ) :-
Private Sub COM1_Click() On Error GoTo ErrorHandler Dim db1 As DAO.Database Dim db2 As DAO.Database Dim rst1 As DAO.Recordset Dim rstCheck As DAO.Recordset Dim strSQL As String Dim strCheck As String Dim intCount As Integer Dim fd As Office.FileDialog If IsNull(Me.Zak_Path.Value) Or Me.Zak_Path.Value = "" Then Set fd = Application.FileDialog(msoFileDialogFilePicker) With fd .Title = "اختر ملف قاعدة البيانات" .Filters.Clear .Filters.Add "قواعد بيانات Access", "*.accdb" .AllowMultiSelect = False If .Show = -1 Then Me.Zak_Path.Value = .SelectedItems(1) Else MsgBox "لم يتم اختيار ملف", vbExclamation + vbMsgBoxRight, "" Exit Sub End If End With End If strPath2 = Me.Zak_Path.Value Set db1 = CurrentDb Set db2 = DBEngine.OpenDatabase(strPath2) strCheck = "SELECT COUNT(*) AS NewCount " & _ "FROM TBInvoiceMain " & _ "WHERE ZatcaXMLSent = -1 AND ID NOT IN " & _ "(SELECT ID FROM [;DATABASE=" & strPath2 & "].TBInvoiceMain2)" Set rstCheck = db1.OpenRecordset(strCheck) If Not rstCheck.EOF Then If rstCheck!NewCount = 0 Then MsgBox "لا توجد فواتير جديدة للترحيل", vbInformation + vbMsgBoxRight, "" GoTo CleanUp End If If MsgBox("سيتم نقل " & rstCheck!NewCount & " فاتورة . هل تريد المتابعة؟", _ vbQuestion + vbMsgBoxRight + vbYesNo, "") = vbNo Then GoTo CleanUp End If End If strSQL = "SELECT DISTINCT TBInvoiceMain.* " & _ "FROM TBInvoiceMain " & _ "WHERE ZatcaXMLSent = -1 AND ID NOT IN " & _ "(SELECT ID FROM [;DATABASE=" & strPath2 & "].TBInvoiceMain2)" Set rst1 = db1.OpenRecordset(strSQL) intCount = 0 If Not rst1.EOF Then Do While Not rst1.EOF On Error Resume Next strSQL = "INSERT INTO [;DATABASE=" & strPath2 & "].TBInvoiceMain2 " & _ "SELECT ID, ID2, InvoiceNumber, FormNumber, InvoiceType, UUID, " & _ "InvoiceSerial, InvoiceDate, InvoiceTime, InvoiceTypeCodeID, " & _ "InvoiceTypeCodeName, InvoiceHash, DateSupply, EndDateSupply, " & _ "PaymentMethod, InstructionNote, TotalDiscount, DiscountReason, " & _ "TaxCode, TaxCodeName, TaxPercentage, InvoiceQR, InvoiceXmlName, " & _ "InvoiceXmlFullPath, EncodedInvoice, XMLCreated, SendingStatus, " & _ "ZatcaStatusCode, ZatcaXMLSent, ZatcaWarningMessage, ZatcaErrorMessage, " & _ "ClearedInvoice, BuyerStreetName, BuyerAdditionalStreetName, " & _ "BuyerBuildingNumber, BuyerPlotIdEntification, BuyerCityName, " & _ "BuyerPostalCode, BuyerCountrySubEntity, BuyerCitySubDivisionName, " & _ "BuyerCompanyName, BuyerTaxNumber, clearedXmlFullPath, BuyerCommercialRegistrationNo " & _ "FROM TBInvoiceMain WHERE ID = " & rst1!ID db1.Execute strSQL If Err.Number = 0 Then strSQL = "INSERT INTO [;DATABASE=" & strPath2 & "].TBInvoiceSub2 " & _ "SELECT ID, InvoiceNumber, ItemName, Quantity, ItemPriceBeforeTax, " & _ "TaxPercentage, TaxCode, Discount " & _ "FROM TBInvoiceSub WHERE ID = " & rst1!ID db1.Execute strSQL If Err.Number = 0 Then intCount = intCount + 1 End If End If On Error GoTo ErrorHandler rst1.MoveNext Loop strSQL = "DELETE TBInvoiceSub.* " & _ "FROM TBInvoiceSub INNER JOIN TBInvoiceMain ON TBInvoiceMain.ID = TBInvoiceSub.ID " & _ "WHERE DateDiff('d', TBInvoiceMain.InvoiceDate, Date()) > 30" db1.Execute strSQL strSQL = "DELETE TBInvoiceMain.* " & _ "FROM TBInvoiceMain " & _ "WHERE DateDiff('d', InvoiceDate, Date()) > 30" db1.Execute strSQL If intCount > 0 Then MsgBox "تم ترحيل " & intCount & " فاتورة بنجاح" & vbCrLf & _ "وتم حذف الفواتير الأقدم من 30 يوم", vbInformation + vbMsgBoxRight, "" Else MsgBox "لم يتم ترحيل أي فواتير", vbInformation + vbMsgBoxRight, "" End If End If CleanUp: If Not rst1 Is Nothing Then rst1.Close If Not rstCheck Is Nothing Then rstCheck.Close Set rst1 = Nothing Set rstCheck = Nothing If Not db2 Is Nothing Then db2.Close Set db2 = Nothing Exit Sub ErrorHandler: MsgBox "حدث خطأ أثناء عملية الترحيل", vbCritical + vbMsgBoxRight, "" Resume CleanUp End Sub  
كود الإسترجاع ( الإستيراد ) :-
Private Sub COM1_Click() On Error GoTo ErrorHandler If IsNull(Me.Text1) Or Trim(Me.Text1) = "" Then MsgBox "الرجاء إدخال رقم الفاتورة المطلوب استرجاعها", vbExclamation + vbMsgBoxRight, "" Me.Text1.SetFocus Exit Sub End If If Not IsNumeric(Me.Text1) Then MsgBox "الرجاء إدخال رقم فاتورة صحيح", vbExclamation + vbMsgBoxRight, "" Me.Text1.SetFocus Exit Sub End If Dim db1 As DAO.Database Dim db2 As DAO.Database Dim rst1 As DAO.Recordset Dim strSQL As String Dim strPath2 As String Dim lngInvoiceNumber As Long Dim fd As Office.FileDialog Dim intDeletedCount As Integer If IsNull(Me.Zak_Path.Value) Or Me.Zak_Path.Value = "" Then Set fd = Application.FileDialog(msoFileDialogFilePicker) With fd .Title = "اختر ملف قاعدة البيانات" .Filters.Clear .Filters.Add "قواعد بيانات Access", "*.accdb" .AllowMultiSelect = False If .Show = -1 Then Me.Zak_Path.Value = .SelectedItems(1) Else MsgBox "لم يتم اختيار ملف", vbExclamation + vbMsgBoxRight, "" Exit Sub End If End With End If strPath2 = Me.Zak_Path.Value lngInvoiceNumber = CLng(Trim(Me.Text1)) Set db1 = CurrentDb Set db2 = DBEngine.OpenDatabase(strPath2) strSQL = "SELECT COUNT(*) AS InvCount " & _ "FROM [;DATABASE=" & strPath2 & "].TBInvoiceMain2 " & _ "WHERE ID = " & lngInvoiceNumber Set rst1 = db1.OpenRecordset(strSQL) If rst1!InvCount = 0 Then MsgBox "الفاتورة رقم " & lngInvoiceNumber & " غير موجودة في قاعدة البيانات الثانية", vbExclamation + vbMsgBoxRight, "" GoTo CleanUp End If strSQL = "SELECT COUNT(*) AS InvCount FROM TBInvoiceMain " & _ "WHERE ID = " & lngInvoiceNumber Set rst1 = db1.OpenRecordset(strSQL) If rst1!InvCount > 0 Then If MsgBox("الفاتورة موجودة بالفعل في القاعدة الحالية . هل تريد استرجاعها مرة أخرى؟", _ vbQuestion + vbYesNo + vbMsgBoxRight, "") = vbNo Then GoTo CleanUp End If End If strSQL = "INSERT INTO TBInvoiceMain " & _ "SELECT * FROM [;DATABASE=" & strPath2 & "].TBInvoiceMain2 " & _ "WHERE ID = " & lngInvoiceNumber db1.Execute strSQL strSQL = "INSERT INTO TBInvoiceSub " & _ "SELECT * FROM [;DATABASE=" & strPath2 & "].TBInvoiceSub2 " & _ "WHERE ID = " & lngInvoiceNumber db1.Execute strSQL strSQL = "UPDATE TBInvoiceMain SET Tran = -1 WHERE ID = " & lngInvoiceNumber db1.Execute strSQL MsgBox "تم استرجاع الفاتورة رقم " & lngInvoiceNumber & " بنجاح", vbInformation + vbMsgBoxRight, "" Me.Text1 = "" Me.Text1.SetFocus CleanUp: If Not rst1 Is Nothing Then rst1.Close Set rst1 = Nothing If Not db2 Is Nothing Then db2.Close Set db2 = Nothing Exit Sub ErrorHandler: MsgBox "حدث خطأ أثناء عملية الاسترجاع", vbCritical + vbMsgBoxRight, "" Resume CleanUp End Sub  
إلى الآن هل الأمور تسير كما نريد ؟؟
المرفقات.zip

وعليكم السلام ورحمة الله وبركاته ..
استخدم في الزر هذا الكود :-
Private Sub upx_Click() Dim raten As Double raten = Nz(Me.rxy, 0) If raten = 0 Then MsgBox "Raten يرجى إدخال قيمة صحيحة في مربع النص", vbExclamation, "تنبيه" Me.rxy.SetFocus Exit Sub End If CurrentDb.Execute "UPDATE tbfr SET rx = ratex * " & raten & ", ry = ratey * " & raten, dbFailOnError Me.Requery End Sub استعلام تحديث داخل الزر يقوم بالمطلوب ,,
 

هذه محاولتي البسيطة ، ان كان هذا طلبك أخبرني بالنيجة
 
توزيع اللجان.accdb

وعليكم السلام ورحمة الله وبركاته ..
الخطأ في الجملة في حدث عند النقر للكومبوبوكس الذي تختار منه نوع الحركة ، إضافة إلى ذلك تم تصحيح مصدر بيانات الكومبوبوكس بدلاً من الاستعلام لجعله من الجدول ( حسب فكرتك ) . وأيضاً اضافة مربع نص لتحديد التاريخ لعرض فواتيره ، وإضافة هذا المربع النصي كشرط في حقل التاريخ داخل الاستعلام "خارج" الذي انشأته .
 
مع العلم انه يمكنك الاستغناء عن الاستعلام الخارجي ، وجعله استعلام مصدر سجلات التقرير مباشرة . ولن تحتاج الاستعلام الخارجي حينها .
اليك التعديل كالتالي ..
 
تقرير مبيعات يةم.accdb

وعليكم السلام ورحمة الله وبركاته ..
فكرة بسيطة خطرت لي .. جرب استعمال الدالة Replace كما في المثال التالي
Private Sub taxn_AfterUpdate() Me.taxn.Value = Replace(Me.taxn.Value, "-", "") End Sub  

هل تأكدت من المكتبات المستخدمة في القاعدة القديمة والجديدة ؟؟؟
واعتقد ان مشكلتك في برنامج التحزيم يا صديقي ، قد يكون تعامله مع ملفات اكسيس يؤثر عليها أثناء ضغطها وإعادة تشفيرها بعد فك الضغط عنها ...
 
وجهة نظر
حاول استخدم فكرة SFX Create By Winrar .. تابع الفيديو التالي

إذن ،، الإتجاه الأول هو نسخة الأوفيس ، وبالنسبة لي كنت سأفكر فيها أول شيء.
الإتجاه الثاني وهو تعريف كرت الشاشة ( أو خلل في الويندوز ) .
حاول ان استطعت تصوير الشاشة مدة ٣٠ ثانية للمشكلة 💡
أيضاً هي أطراف أفكار 😇 ..

وعليكم السلام ورحمة الله وبركاته ،،
أخي الكريم حياك الله مراراً وتكراراً .. ما شاء الله نشيط اليوم 
سأنصحك نصيحة قد تفيدك مستقبلاً في حال كانت لديك رغبة في تطوير مهاراتك في اكسيس .
حاول الإبتعاد عن اسماء الحقول العربية  ، أما فيما تبقى فأنا مسامحك ..
بالنسبة لفكرتك قمت بتعديل بسيط بإضافة طابعي على نموذج الحذف الجديد ..
هذا الملف بعد التعديل جربه بعد إضافة سجلات لتجربته
 
حدف السجل.accdb

باعتقادي لأنك تستعمل حقل الترقيم التلقائي ( AutoNumber ) . أما فيما يخص الترقيم فهنا أمامك طريقان :-
أن كان الترقيم ليس مفتاح اساسي مشترك ومرتبط مع جداول أخرى ( وبالنسبة لي هذا لا اشجعه ولا اعتمده في الترقيم الفريد للموظفين أو الزبائن أو العملاء ... إلخ ) أي بمعنى آخر هو فقط مجرد حقل لا تستخدمه للربط فأمر الترقيم غير مهم لأنهك هنا ستضطر لعمل ضغط وإصلاح للقاعدة كلما حذفت سجل  للمحافظة على تسلسل الترقيم التالي ، يعني لو عندك 10 سجلات وحذفت السجل 10 ، سيكون التالي 11 في كلا الحالتين ، ولو حذفت الـ 10 كاملة وأضفت سجل فسيكون الأول أيضاً ترقيمه 11 .. إذا لا مفر من أتباع نهج وطريق آخر ,, أما اذا كان حقل الترقيم مفتاح أساسي ( وكما أخبرتك سابقاً أنني لا أشجع هذه الفكرة ) ، لا انصحك بالتلاعب بالترقيم لأن ذلك يؤثر على سير العلاقات بين الجداول ( خصوصاً إن كان هذا الحقل ذو علاقة رأس بأطراف مع جدول آخر ) .. أتمنى أن تكون الفكرة قد توضحت لك .. ولكن إجابةً لسؤالك راجع هذا الموضوع ، قد تجد ضالتك فيه .

أخي الكريم فضلاً لا أمراً ، يجب لفت انتباهك لضرورة متابعة مواضيعك التي تطرحها بإغلاق الموضوع باختيارك افضل إجابة عند حصولك على الحل المناسب والذي يلبي حاجاك ومطلبك .

تنسيق التاريخ في الحقل داخل الجداول ( 7/1/2024 ) وليست ( 1/7/2024 )
ثم انه لا يوجد لديك مشاريع توافق 11/1/2024 ، فسيتم جلب القيم بين التاريخين . هذا من جهة . ومن جهة ثانية القيمة الافتراضية لمربعات النص التي يتم جلب قيم التاريخ فيها على سبيل المثال
=[Forms]![استعلام عن اجمالي الصناديق]![lastOfالاشهر] هنا سيتم جلب آخر قيمة وليست القيمة التي أدخلتها في التعليمة
 
اعتقد هذه مشكلتك 

وعليكم السلام ورحمة الله وبركاته ..
اخي العزيز من باب التوضيح ، هل الفترة التي تقصد بها في مثالك = التاريخ ؟؟؟؟؟؟؟
اذا كان جوابك نعم ، فإليك المرفق بعد التعديل باضافة طريقتين ، الأولى استعلام من خلال كود VBA والثانية استعلام SQL
SKL.accdb

اخي @moho58 ..
جرب هذا السلوك  :-
 
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer) On Error Resume Next Dim newKeyCode As Integer Select Case KeyCode Case vbKeyDown DoCmd.GoToRecord , , acNext Case vbKeyUp DoCmd.GoToRecord , , acPrevious Case vbKeyRight newKeyCode = vbKeyLeft KeyCode = newKeyCode Case vbKeyLeft newKeyCode = vbKeyRight KeyCode = newKeyCode End Select End Sub  

رغم أنك في قسم الآكسيس ، والمفترض ان تطرح سؤالك في قسم الويندوز والبرامج على ما اعتقد ، إلا أنه قد يكون هناك فرصة باستخدام الـ PowerShell كالآتي كمحاولة :-
 
Get-ChildItem -File | Group-Object { $_.BaseName } | ForEach-Object { Compress-Archive -Path $_.Group.FullName -DestinationPath "$($_.Name).zip" } في داخل المجلد الذي يحتوي ملفاتك ، اضغط مفتاح Shift داخل المجلد والزر الأيمن للماوس اختر Open PowerShell window here من القائمة . ثم الصق السطر السابق .