طاهر اوفيسنا

التقارير عير موجودة الكود عند Private Sub cmd_Pay_installments_Click() ثم الى الجدول tbl_Loans مباشرة

غير تاريج الجهاز الى شهر مارس وافتح الفورم سترى النتيجة عندها اذهب الى الجدول tbl_Loans واغمل الفلترة للعامل 89 كعينة سترى انقطاع القروص المبلغ المقتطع = 5000 ودفع الانخراط في المبلغ المقتطع = 3000 والمبلغ المقتطع الذي تم تلقائيا هو = 1500 وهذا الاخير هو المطلوب لازم مايكون معذرة المرفق الذي ارفقته قبل به اقتطاع مارس الان حذفته لكي يتم الفهم وارفقت مرفق جديد افتطاع مارس.rar

شكرا استاذ على الالتفاتة الطيبة موضوع وهو تعديل على كود اقتطاع الانخراط بالاصح العامل الذي يدفع المبلغ 3000 خلال جانفي او فيفري او افريل او ماي او جوان يستنثني من الاقتطاع خلال شهر مارس و جويلية الكود 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 'jusf a flag 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 'End Select 'GoTo I_am_Done ' ..........................الشطر الثاني اقتطاع الانخراط '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 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 ملاحظة : الكود ينتقل الى الاقتطاعات خلال شهري مارس وجويلية فقط الفورم FrmTransfer اول مرة عند فتحه عند دخول الشهر يذهب الى الاكواد عند الفتح اتمنى ايجاد حل في القريب العاجل 20250126.rar

للرفع

اساتذتي الكرام اذا كان الامر صعب لهذه الدرجة فاني اتنازل عليه والان كيف استثني عامل دفع مبلغ الانخراط كاملا يلزم الاقتطاع التلقائي خلال شهر 3و7 الاستثناء يكون في الشرط الثاني من الكود طبعا

هل من معين ربي يجازيكم

للرفع

فكيف ابخل عليك استاذي الكريم وأنا في أمس الحاجة الى الحل النموذجي الصحيح الكود به مشكلة بعد هذا الشرط If Month(Now()) = 3 Or Month(Now()) = 7 اولا : الكود عبارة عن جزئين الجزء الاول :هو اقتطاع القروض والكهرومنزلية خلال السنة باستثناء Nr اكبر او يساوي 6 تم الحل والحمد لله الجزء الثاني : هو اقتطاع الانخراط والمقدر ب 3000 للسنة خلال شهري مارس وجويلية كل على حدى بمبلغ 1500 خلال هاذين الشهرين يستمر انقطاع الواقع في الجزء الاول هنا وهو بيت القصيد يستنى Nr<6 "رقم الوظيفة" من انقطاع الانخراط والمقدر ب 1500 يعني الكود لايضيف سجل لهذه الفئة ملاحظة : المنخرط رقم 81 ورقم وظيفته 9 الذي استثني من اقتطاع القروض هنا ايضا يستنى من انقطاع الانخراط انظر ليس لديه سجل بالاحمر في الصورة

المشكلة في الشطر الثاني اي يذهب الكود له عند الشهر 3 والشهر 7 لانه فما اقتطاع Inkhiratيساوي 1500.00 الملف اكسل المرفق يوضح استاذي العزيز موضوع الطلب هو تغيير detach بـ Nr Inkhirat.xlsx

يبدو ان هناك مشكلة في الاستثناء myCriteria = "[Nr] < 6" مع العلم ان المشكل يظهر غير في الشرط If Month(Now()) = 3 Or Month(Now()) = 7 شهر 1 و 2 عادي اما شهر 3 و 7 ففيهما خاصية اقتطاع الانخراط 1500.00 يتم فيه ظهور الميساج ولم يتم اقتطاع المبلغ 20250123.rar

وهو كذالك استاذ والان كيف يتم استنثاء في الشطر 2 من الكوذ 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 = "[Nr]= 1 " 'myCriteria = myCriteria & " Or [Nr]= 2 " 'myCriteria = myCriteria & " Or [Nr]= 3 " 'myCriteria = myCriteria & " Or [Nr]= 4 " 'myCriteria = myCriteria & " Or [Nr]= 5 " 'myCriteria = myCriteria & " Or [Nr]= 10 " Set rstE = CurrentDb.OpenRecordset("Select * From Employee Where " & myCriteria) rstE.MoveLast: rstE.MoveFirst Rc = rstE.RecordCount For i = 1 To Rc 'check if payment is already entered, if it is, then skip this Record rst.FindFirst "[Loan_Type]='Inkhirat' And [EmployeeID]=" & rstE!EmployeeID & " And [Payment_Month]=#" & Me.txtMonth & "#" ' TblOther مبلغ لانخراط المقرر في جدول 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") 'to be used in Other loan Form 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 'clean up rst.Close: Set rst = Nothing End If Exit Sub err_cmd_Pay_installments_Click: If Err.Number = 3021 Then 'No Records, ignore Resume Next Else MsgBox Err.Number & vbCrLf & Err.Description End If End Sub علما انه شغال 100 بالمئة ولكن احبذ تغيير myCriteria = "[detach]='موظف'" myCriteria = myCriteria & " Or [detach]='متعاقد كامل'" myCriteria = myCriteria & " Or [detach]='متعاقد جزئي'" myCriteria = myCriteria & " Or [detach]='عون نظافة'" ب : Nr >= 6

السام عليكم اساتذتي الكرام ارجو أن لا أكون عبء عليكم بطلباتنا المتكررة والشبه يوميا لديا Nr "نوع الوظيفة"من 1 الى 16 عند الاقتطاع الشهري احبذ التعديل على الكود لكي يستثني Nr >=6 اي يضع له في جدول tbl_Loans Payment_Made= 0.00 علما انني وقعت في مشكلة عندما استبدلت myCriteria myCriteria = "[detach]='موظف'" myCriteria = myCriteria & " Or [detach]='عامل متعاقد توقيت كامل'" myCriteria = myCriteria & " Or [detach]='عامل متعاقد توقيت جزئي'" myCriteria = myCriteria & " Or [detach]='حارس متعاقد توقيت جزئي'" myCriteria = myCriteria & " Or [detach]='عون نظافه وتطهير'" بهذه لكي استنثي ماطلبت myCriteria = "[Nr]= 1 " myCriteria = myCriteria & " Or [Nr]= 2 " myCriteria = myCriteria & " Or [Nr]= 3 " myCriteria = myCriteria & " Or [Nr]= 4 " myCriteria = myCriteria & " Or [Nr]= 5 " والكود الي يقطتع Select Case MsgBox(" هل تريد أن يتم توزيع الإقتطاعات لشهر " & Me.txtMonth, vbYesNo + vbQuestion + vbDefaultButton1) Case vbYes For i = 1 To Rc rst.Edit If rst!Loan_Type = "Cridi" Then rst!Payment_Made = rst!Loan_Made: rst!sadad = rst!Loan_Made: rst!Loan_Remise = 0 If rst!Loan_Type = "Elec" Then rst!Payment_Made = rst!Loan_Made: rst!sadad = rst!Loan_Made: rst!Loan_Remise = 0 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 فأين يتم وضع الشرط جزاكم الله خيرا

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

لاحظ ملف الاكسل Mois12.xlsx

لان النموذج مفتوح اغلق النموذج وافتح الاستعلام وسترى النتيجة استاذ ابو احمد حياك الله ان شاء الله انك طبت للشفاء يارب الاستعلام من تصميم الاستاذ القدير جعفر حياه الله ولكن الاستعلام يجلب النتيجة الصحيحة وهي باقي القروض الى غاية 2024/12/31 او 2024/12/01 النتيجة 1281.000.00 2025-01-22_07-29-09.rar

استاذ الاستعلام Baghi3112 ظهرت لك النتيجة 54000.00 ام كيف ؟

كيف ؟ يأتي بمجموع الباقي Remaining_Cridi وهي النتيجة الصحيحة

استاذي العزيز انا وضحت لك بالمنطق الحسابي تسلم قروض مالية على عدة اشهر لكي يسترجع مجموع القروض هي مجموع Loan_Made مبلغ الاشهر المقتطعة هي مجموع Payment_Made مجموع القروض - مبلغ القروض للاشهر المقتطعة = الباقي ولكن لماذا النتيجة خاطئة ؟؟؟ مقارنة بالاستعلام Baghi3112

ظهرت النتيجة كما يلي

صح كما اشرت استاذي ولكن لم افهم النتيجة تظهر خاطئة مانعرف ايحسب على تاريخ Payment_Month ام على تاريخ Auto_Date في الحدول tbl_Loans

استاذ العزيز انظر لهذا الكود في الوحدة النمطية fAdd_Observations لربما يوضح لك بعض الاشياء المخفية ولربما انا لم اوضحها Function Sum_Remaining(p, ID_Emp As Integer, t As String, Loan_ID) As Currency 'On Error Resume Next 'P = DateSerial(Year(P), Month(P), 1) M = Month(p) Y = Year(p) If Loan_ID <> 0 Then If t = "Cridi" Then s = DSum("[Payment_Made]", "tbl_Loans", "[EmployeeID]=" & ID_Emp & " And month([Payment_Month])=" & M & " And Year([Payment_Month])=" & Y & " And [Loan_Type]='Cridi'") End If If t = "Elec" Then s = DSum("[Payment_Made]", "tbl_Loans", "[EmployeeID]=" & ID_Emp & " And month([Payment_Month])=" & M & " And Year([Payment_Month])=" & Y & " And [Loan_Type]='Elec'") End If Else If t = "Inkhirat" Then s = DSum("[Payment_Made]", "tbl_Loans", "[EmployeeID]=" & ID_Emp & " And month([Payment_Month])=" & M & " And Year([Payment_Month])=" & Y & " And [Loan_Type]='Inkhirat'") End If End If If IsNull(s) Then Sum_Remaining = 0 Else Sum_Remaining = s End If End Function

ظهر المبلغ Total_Net_Value=54000.00 والصحيح 1,281,000.00

استاذي الكريم طريقة جلبه من الجدول لم تفلح معي ابدا يعني ما أعطاني النتيجة الصحيحة اطلاقا لهذا ذهبت الى الاكواد لانها اعطتني النتيجة الصحيحة الجدول هو tbl_Loans الحقل هو مجموع " Loan_Made ناقص Payment_Made" التاريخ هو Payment_Month ويكون الى غاية 2024/12/31 او 2024/12/01 حيث النتيجة تكون 1,281,000.00 الشرط Loan_ID اكبر من 0

السلام عليكم اساتدتي الكرام وجدت مشكلة في جلب قيمة مالية من استعلام بمعيار تاريخ اخر السنة كلما حاولت يكتب النتيجة 0 فورم FrmMada5il Me.txtYear = Year(Date) Me.txtMonthe = #12/31/2024# Me.Roming = Nz(DSum("[Remaining_Cridi]", "[Baghi3112]", "[Forms]![FrmMada5il]![Payment_Month1]=" & [txtMonthe]), 0) الاستعلام Baghi3112 SELECT tbl_Loans.Loan_ID, tbl_Loans.EmployeeID, Format([Payment_Month],"mmmm yyyy") AS Month_Year, [Forms]![FrmMada5il]![txtMonth] AS Payment_Month1, Sum_Remaining([Payment_Month1],[EmployeeID],"Cridi",Loan_ID) AS Cridi, Count_Remaining([Payment_Month1],[EmployeeID],[Loan_ID],"Cridi") AS Remaining_Cridi FROM tbl_Loans GROUP BY tbl_Loans.Loan_ID, tbl_Loans.EmployeeID, Format([Payment_Month],"mmmm yyyy"), [Forms]![FrmMada5il]![txtMonth] HAVING (((Format([Payment_Month],"mmmm yyyy"))=Format([Forms]![FrmMada5il]![txtMonth],"mmmm yyyy"))); ارجو المساعدة 20250121.rar