اقتطاع تلقائي باستنثاء الذين دفعو مبلغ الانخراط

[طاهر اوفيسنا]

السلام عليكم اساتذة رغم الحاحي الشديد قبل لهذا الطلب ولكن لم اجد استجابة فاردت ان اعمل موضوع جديد بتوضيح اكثر فلبرما اجد الحل المناسب

افتطاع مارس.rar

[Foksh]

وعليكم السلام ورحمة الله وبركاته ,,

أعاننا الله وإياكم على تحقيق المطلوب ..

بدايةً سيتم التحقق من شهر الاقتطاع (3 أو 7 ) ، ثم سيتم البحث عن أي دفع مباشر ( 3000 ) في الفترة المحددة كالآتي :-

1. جانفي / فيفري لشهر مارس

2. أفريل/ماي/جوان لشهر جويلية

الآن سيتم تخطي الموظف إذا وجد له عملية دفع مباشر في الفترة المحددة .

إلى الآن هل هذا صحيح ..؟؟؟

 

 

وأخبرني كيف سأعرف أن النتيجة المطلوبة تحققت !!!
في الجدول أم أين ؟؟

تم تعديل يناير 28 بواسطه Foksh

[طاهر اوفيسنا]

26 دقائق مضت, Foksh said:

وأخبرني كيف سأعرف أن النتيجة المطلوبة تحققت !!!
في الجدول أم أين ؟؟

شكرا استاذ على الاهتمام نعم النتيجة المحققة تكون في الجدول اعمل فلترة للعامل  89 مثلا بعد العملية وسترى ذلك هل لدية سجل واحد انخراط ام سجلين اذا وجدت سجل واحد فالكود صحيح اني انتظر اهتمامك وتعديلك بفارغ الصبر وشكرا

تم تعديل يناير 28 بواسطه طاهر اوفيسنا

[Foksh]

جرب هذا التعديل ..

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

 

[طاهر اوفيسنا]

وهو كذلك التعديل كان في محله

بوركت استاذ Foksh ربي يحفطك

[Foksh]

بارك الله فيك صديقي ,,
دائماً التوضيح في الطلب والشرح الكافي و الوافي حتى لو في 100 سطر ، يعود لك بالنتيجة المطلوبة التي تبحث عنها .

 

أتمنى لك الفائدة دائماً 

[طاهر اوفيسنا]

في 28‏/1‏/2025 at 18:52, Foksh said:

بارك الله فيك صديقي ,,
دائماً التوضيح في الطلب والشرح الكافي و الوافي حتى لو في 100 سطر ، يعود لك بالنتيجة المطلوبة التي تبحث عنها .

 

أتمنى لك الفائدة دائماً 

وفيك بارك الله استاذي العزيز 

فعلا فهم السؤال نصف الاجابة

شكرا شكرا على اهتمامك والسهر على ايجاد الحل المناسب لموضوعي 

تقبل تحياتي القلبية الخالصة 

[Foksh]

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