Foksh

كلاا الاستعلام كما رأيت لم يجلب اي قيمة النتيجة من هذا الكود Private Sub txtMonthe_AfterUpdate() Dim Total As Double Dim EndDate As Date EndDate = CDate(Me.txtMonthe.Value) Total = Nz(DSum("Loan_Made - Payment_Made", "tbl_Loans", "Payment_Month <= #" & EndDate & "# AND Loan_ID > 0"), 0) Me.Roming = Format(Total, "Standard") End Sub لتجنب مشاكل التنسيق ، نصيحة جميلة ومفيدة .. لكن النتيجة نفسها في تجربة اخونا @كريمو2

مع العلم ان الاستعلام Baghi3112 لا يأتي بنتائج

صديقي انا اعرف النتيجة ، ولكنت من يجب ان يتحقق منها ؟؟ بناءً على معلوماتك ،، مجموع Loan_Made ناقص مجموع Payment_Made ضمن شرط التاريخ !!!!

انظر .. Private Sub txtMonthe_AfterUpdate() Dim Total As Double Dim EndDate As Date EndDate = CDate(Me.txtMonthe.Value) Total = Nz(DSum("Loan_Made - Payment_Made", "tbl_Loans", "Payment_Month <= #" & EndDate & "# AND Loan_ID > 0"), 0) Me.Roming = Format(Total, "Standard") End Sub

اجبني على سؤالي هنا .. انسى امر الدالة حالياً

حسب ما فهمت : مجموع Loan_Made ناقص مجموع Payment_Made ، صحيح ؟؟ هذه الاستعلام ، صحيح لاظهار القيم ؟ SELECT Loan_ID, Payment_Month, Loan_Made, Payment_Made, (Loan_Made - Payment_Made) AS Net_Value FROM tbl_Loans WHERE Payment_Month <= #12/31/2024# AND Loan_ID > 0;

للتحقق ، جرب هذا الاستعلام واخبرني بنتيجته .. 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

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