Foksh

لم افهم آلية العمل على برنامجك ، ولكن من خلال ما فهمت من تتبع مسار الكود / جرب هذا التعديل . فأنت تعرف مداخل ومخارج مشروعك وكيفية العمل عليه Private Sub cmd_Pay_installments_Click() On Error GoTo err_cmd_Pay_installments_Click Dim rst As DAO.Recordset Set rst = CurrentDb.OpenRecordset("Select * From tbl_Loans Where [Payment_Month]=CDATE('" & Me.txtMonth & "')") rst.MoveLast: rst.MoveFirst Rc = rst.RecordCount a1 = 0 a2 = 0 If Rc = 0 Then: MsgBox " لا توجد إقتطاعات لشهر " & Format(Me.txtMonth, "mmmm") & " " & Year(Me.txtMonth), vbInformation: Exit Sub 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 If Month(Now()) = 3 Or Month(Now()) = 7 Then Dim rstE As DAO.Recordset Set rst = CurrentDb.OpenRecordset("Select * From tbl_Loans") myCriteria = "[Nr] < 6" Set rstE = CurrentDb.OpenRecordset("Select * From Employee Where " & myCriteria) rstE.MoveLast: rstE.MoveFirst Rc = rstE.RecordCount For i = 1 To Rc 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 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 مع العلم أنني لم أجد الزر cmd_Pay_installments في النموذج .. على العموم ، جرب الكود وأخبرني بالنتيجة ..

سامحك الله أستاذ @ناقل ، لك حرية الاستخدام كما تريد ،، ويسعدني رؤية تعديلاتك التي تفكر فيها .. جل ما نقدمه جميعاً هنا هو لوجه الله تعالى أولاً ، ثم لنستفيد منه جميعاً .

ممتاز ، بما أن الجزء الأول قد تم حله ,, الجزء الثاني جرب هذا التعديل .. If Month(Now()) = 3 Or Month(Now()) = 7 Then Dim rstE As DAO.Recordset Set rst = CurrentDb.OpenRecordset("Select * From tbl_Loans") myCriteria = "[Nr] < 6" Set rstE = CurrentDb.OpenRecordset("Select * From Employee Where " & myCriteria) rstE.MoveLast: rstE.MoveFirst Rc = rstE.RecordCount For i = 1 To Rc 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 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

وعليكم السلام ورحمة الله وبركاته.. رغم عدم وضعك لمرفق مساعد ، ولتلافي الخطأ جرب التعديل التالي:- 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.00 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 End Select بهذه الطريقة، سيتم استثناء الأفراد الذين لديهم Nr >= 6 وتعيين Payment_Made إلى 0.00 لهم، بينما يتم تطبيق القواعد الأصلية على الباقي.

وفيكم اخي الكريم .. شكراً لمرورك العطر

عشان تعرف بس معزتك قد ايه

هذه محاولتي البسيطة Test ID.accdb

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

Private Sub Command5_Click() If Me.Image.Picture <> Application.CurrentProject.Path & "\Pictures\" & Me.FirstName & ".jpg" Then Me.Note1 = Null End If End Sub

لم انتبه لردك استاذ @Eng.Qassim الا بعد اضافة ردي 🤦🏻‍♂️

مشاركة ، بعد إذن الأساتذة.. Private Sub YourSubName() On Error GoTo ErrorHandler If IsNull(Me.Image.Picture) Or Me.Image.Picture = "" Then Me.Novel = Null Else Me.Note2 = Null End If Exit Sub ErrorHandler: MsgBox "An error occurred: " & Err.Description, vbCritical, "Error" End Sub

أولاً أخي الكريم ،، اختيار أفضل إجابة تختارها للحل ، وليس لصاحب الموضوع

للتوضيح ، يبدو أنني لم أفسر بشكل أوضح أخي الكريم .. بعد تسجيلك للدخول باسم الموظف سيتم انشاء المجلد عندما تختار اضافة مرفقات PDF ..

بارك الله فيكم معلمنا @ابوخليل إن كنت تقصد الدوائر التي باللون الأصفر والأخضر ( التي تمثل الساعة ) ، فهي أزرار وليست مربعات تسمية أو نص

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

دائماً ترفع معنوياتي بمداخلاتك وما شاء الله عليك مهندسنا الغالي ,, سلمت على هديتك ومشاركتك الجميلة

لا اعلم ، قد يكون هذا السبب لعدم ظهور نتائج الاستعلام . على العموم الاستعلام لا يعطي اي نتيجة مع أو بدون فتح النموذج .. المهم انك وجدت ضالتك ، والشكر موصول للأستاذ @AbuuAhmed

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

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