Foksh

للتحقق ، جرب هذا الاستعلام واخبرني بنتيجته .. SELECT SUM(Loan_Made - Payment_Made) AS Total_Net_Value FROM tbl_Loans WHERE Payment_Month <= #12/31/2024# AND Loan_ID > 0;

اخي الكريم بدلاً من الدخول في متاهة تتبع الاكواد ، ما الحقل الذي تريد جلب مجموعه من الجدول بشرط التاريخ ؟؟؟

بما أنني شاركت في متابعة سابقة لنفس الموضوع ،جرب هذا الكود في زر التوزيع ,, 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

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

السلام عليكم ورحمة الله وبركاته ، أخواني وأساتذتي ومعلمينا ( دون استثناء ) 📌 اليوم سأقدم لكم فكرة لإنشاء ساعة رقمية مشابهة لألواح الإعلانات المضيئة ، ولكن بطريقة و نكهة مختلفتين كالعادة ▫▪◽◾◻◼ . صورة للنتيجة .. المرفق مفتوح المصدر دون إطالة BackLight2.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

ولا يهمك ..

مع انها مش محتاجة IT .. شوف

السبب انك مش فاتح الباور شيل كمسؤوووووول

تفضل أخي @سلمان الشهراني ، تعديلاتي للنقاط ( 1 و 2 و 3 ) فقط !! النقطة 5 لم استفهمها بشكل واضح . تعديلاتي التي تمت :- 1. إضافة مربع نص Zak_Path لتسجيل المسار به عند اختيار ملف القاعدة المستهدفة لترحيل البيانات لها . 2. تم اضافة حقل جديد = Tran من نوع Yes/No في جدول (TBInvoiceMain) في القاعده Zakat1 ، حتى يمييز الفواتير التي تم استرجاعها . بحيث يصبح الحقل (Yes = -1) اذا تم استراجاعه . التعديلات في كود زر الترحيل كالتالي :- 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 Set fd = Application.FileDialog(msoFileDialogFilePicker) With fd .Title = "اختر ملف قاعدة البيانات" .Filters.Clear .Filters.Add "قواعد بيانات Access", "*.accdb" .AllowMultiSelect = False If .Show = -1 Then strPath2 = .SelectedItems(1) Else MsgBox "لم يتم اختيار ملف", vbExclamation + vbMsgBoxRight, "" Exit Sub End If End With 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, "" strSQL = "SELECT COUNT(*) AS OldCount " & _ "FROM TBInvoiceMain " & _ "WHERE DateDiff('d', InvoiceDate, Date()) > 30" Set rst1 = db1.OpenRecordset(strSQL) If rst1!OldCount > 0 Then If MsgBox("يوجد " & rst1!OldCount & " فاتورة مضى عليها أكثر من 30 يوماً . هل تريد حذفها؟", _ vbQuestion + vbYesNo + vbMsgBoxRight, "") = vbYes Then 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 MsgBox "تم حذف " & rst1!OldCount & " فاتورة قديمة بنجاح", vbInformation + vbMsgBoxRight, "" Else MsgBox "لم يتم حذف الفواتير القديمة", vbInformation + vbMsgBoxRight, "" End If Else MsgBox "لا توجد فواتير مضى عليها أكثر من 30 يومًا", vbInformation + vbMsgBoxRight, "" End If 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 الملف = Zakat.zip

لتبسيط الأمور ، تستطيع فعل هذه الخطوة من خلال الويندوز نفسه .. 1. افتح PowerShell كمسؤول (Administrator) . 2. حدد المسار الخاص بالمجلد من خلال السطر :- cd C:\Users\Golden\Desktop\New طبعاً المجلد New الذي يحتوي المجلدات المستهدف تغييرها .. وأنصحك بعدم استخدام مسار مجلد من كلمتين تفصل بينهما مسافة ، استخدم "_" أو الاسم المكون من كلمة واحدة ,, على العموم 3. بعد التأكد أنك في مسار المجلد الذي يحتوي المجلدات التي تريد تغييرها .. اكتب الكود التالي :- Get-ChildItem -Directory | Where-Object { $_.Name -like "New folder *" } | ForEach-Object { Rename-Item -Path $_.FullName -NewName ($_.Name -replace '^New folder ', '') } 4. بانتظار تجربتك ..

بالعكس اخي الكريم @أحمد العيسى ، بارك الله فيكم وفي جهودكم ، وجعله في ميزان حسناتكم. قد يكون معظم الذين مرّوا في الموضوع وقاموا بتحميل البرنامج للإطلاع عليه ليسوا من ذوي الإختصاص كمعلمين أو مدرسين كحالي أنا العبد الفقير الى الله 😇 ، ولكنك تؤجر على ما تقدمه بظهر الغيب على طرحك الجميل ، وليس شرطاً أن يكون لحظياً . فلا تنتظر الشكر والتقدير والثناء إلا من الله ؛ واسأله ما دام الأمر بيده 🤲 . ومن جهة أخرى ما رأيك بتطوير وتحسين التصميم مبدأياً ؟؟ فالعين تأكل قبل الفم مما ترى 😉 ودمتم في رعاية الله

تم قراءة التفاصيل المطلوبة ، وإن شاء الله بالقريب سيتم الرد بالتعديلات حال وصولي للكمبيوتر 🤗 . في النقطة 4 تتوقف الأمور على أن رقم الفاتورة المعتمد هو الحقل ID وهو حقل ترقيم تلقائي ، صحيح ؟؟؟ وهنا سبب مشكلتك في الترقيم

وعليكم السلام ورحمة الله وبركاته.. 😇 طبعاً تستطيع اخي الكريم ، اعطينا مثال لمجلدات فارغة على الاقل ، تستطيع ارفاق 1000 مجلد فارغ بحجم لا يتعدى 5 كيلو بايت أخي @تامر خليفه

أعتذر من الأستاذ @ناقل ، ولكن الأخ العزيز @abofayez1 ، هل قمت بتجربة الكود الذي اخترته كأفضل إجابة ؟؟؟ هل لديك المكتبة أو قمت بإضافتها Microsoft Forms 2.0 Object Library (MSForms) ؟؟؟؟؟

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

وعليكم السلام ورحمة الله وبركاته.. في مديول جديد ، الصق الكود التالي :- Private Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hwnd As LongPtr) As Long Private Declare PtrSafe Function EmptyClipboard Lib "user32" () As Long Private Declare PtrSafe Function CloseClipboard Lib "user32" () As Long Sub ClearClipboard() If OpenClipboard(0) Then EmptyClipboard CloseClipboard End If End Sub ويتم الاستدعاء باسم الصب ClearClipboard

طيب اسمح لي بسؤال غريب شوية .. المستخدم للبرنامج هيستفيد ايه ؟؟؟؟؟ المفروض الجداول تكون غير ظاهرة ليك كمستخدم !!!!!🙄 إنت بس وصلني للهدف واتركها على الله

أعانكم الله على ما بدأتم ،، ونسأل الله التوفيق لنا ولكم ، ومتابع معك إن شاء الله بتكاتف الجهود طبعاً

فسرها لي دي .. ابراهيم وسام اريج إزاي !!!!!!!!!!! أبجدياً يفترض يكون وسام آخر طالب !!!

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

وعليكم السلام ورحمة الله وبركاته ,, تصدقني لو قلت لك اني قرأت الطلب أكثر من مرة وما توضحت لي الفكرة الآن لما تسجل طالب جديد ، ولنفترض انه رقمه حتماً بيكون 31 بناءً على السجلات اللي عندك في الملف المرفق . ولنفترض ايضاً ان اسم الطالب وسام في الصف الأول أ ... إلخ . السؤال اللولبي هو انت محتاج يكون ترتيب السجلات في الجدول أبجداً حسب اسم الطالب ولا أنا فهمت غلط ؟؟

وعليكم السلام ورحمة الله وبركاته .. استخدم في الزر هذا الكود :- 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 استعلام تحديث داخل الزر يقوم بالمطلوب ,,

تم التعديل بإذن الله .. تم التعديل بحيث عند استرجاع فاتورة ( جرب على الفاتورة رقم 4 حيث تم التعديل للتاريخ = 2024-11-16 للتجربة) ، سيتم سؤال المستخدم انه هذه الفاتورة مضى عليها أكثر من 30 يوم ، هل تريد الحذف ( الأمر متروك للمستخدم بالحذف أو لا ..) في اي جزء لاحظت انه لا يتم الترحيل بشكل صحيح ...؟ فبناءً على الملف المرفق تمت التجربة على السجلات بشكل منفصل والتدقيق قبل وبعد الترحيل أو الإستيراد . اذا تمكنت من ارفاق صورة أو توضيح لتلافي المشكلة ، وأكيد في الأمور المالية والحسابية الخطأ يكون قاتلاً Zakat.zip

وعليكم السلام ورحمة الله وبركاته أستاذ @سلمان الشهراني ، لي مداخلة بسيطة :- في مثالك لاحظت ان رقم الفاتورة مكرر في سجلات القاعدة الأولى ، هل هذا منطقي أم هو مجرد مثال ؟؟ في حال كان هو فعلاً كذلك ، فعلى أي أساس نريد استرجاع فاتورة محددة قد يكون لها سجلات مكررة بنفس رقم الفاتورة ؟؟؟؟؟ على العموم إليك اقتراحي :- في زر الترحيل الى القاعدة الأولى استخدم الكود التالي :- 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 strPath2 As String Dim intCount As Integer strPath2 = CurrentProject.Path & "\Zakat2.accdb" Set db1 = CurrentDb Set db2 = DBEngine.OpenDatabase(strPath2) strCheck = "SELECT COUNT(*) AS NewCount " & _ "FROM TBInvoiceMain " & _ "WHERE 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 InvoiceNumber NOT IN " & _ "(SELECT InvoiceNumber 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 InvoiceNumber = " & rst1!InvoiceNumber 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 InvoiceNumber = " & rst1!InvoiceNumber 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 strPath2 = CurrentProject.Path & "\Zakat2.accdb" lngInvoiceNumber = CLng(Trim(Me.Text1)) Set db1 = CurrentDb Set db2 = DBEngine.OpenDatabase(strPath2) strSQL = "SELECT COUNT(*) AS InvCount " & _ "FROM [;DATABASE=" & strPath2 & "].TBInvoiceMain2 " & _ "WHERE InvoiceNumber = " & 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 InvoiceNumber = " & 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 InvoiceNumber = " & lngInvoiceNumber db1.Execute strSQL strSQL = "INSERT INTO TBInvoiceSub " & _ "SELECT * FROM [;DATABASE=" & strPath2 & "].TBInvoiceSub2 " & _ "WHERE InvoiceNumber = " & 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 تم الإعتماد هنا على رقم الفاتورة من الحقل InvoiceNumber ، وأخبرني بالنتيجة . المرفق بعد التعديل .. Zakat.zip .