الاقتطاع الشهري لمبالغ مالية بإستناء

**طاهر اوفيسنا** · يناير 23

السام عليكم اساتذتي الكرام

ارجو أن لا أكون عبء عليكم بطلباتنا المتكررة والشبه يوميا

لديا 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** · يناير 23

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

رغم عدم وضعك لمرفق مساعد ، ولتلافي الخطأ جرب التعديل التالي:-

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 لهم، بينما يتم تطبيق القواعد الأصلية على الباقي.

**طاهر اوفيسنا** · يناير 24

في 23‏/1‏/2025 at 23:47, Foksh said:

بهذه الطريقة، سيتم استثناء الأفراد الذين لديهم Nr >= 6 وتعيين Payment_Made إلى 0.00 لهم، بينما يتم تطبيق القواعد الأصلية على الباقي.

وهو كذالك استاذ

والان كيف يتم استنثاء في الشطر 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

تم تعديل يناير 24 بواسطه كريمو2

**ابو عارف** · يناير 24

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

اولا عليك ذهاب الى اول سطر في موضع و تعديل اول كلمة

ثانيا جرب احاطة شروط سابقة بين قو سين ثم اضافة شرط جديد أو الصق الكود التالي

myCriteria = "([detach]='موظف'"
        myCriteria = myCriteria & " Or [detach]='عامل متعاقد توقيت كامل'"
        myCriteria = myCriteria & " Or [detach]='عامل متعاقد توقيت جزئي'"
        myCriteria = myCriteria & " Or [detach]='حارس متعاقد توقيت جزئي'"
        myCriteria = myCriteria & " Or [detach]='عون نظافه وتطهير')"
		myCriteria = myCriteria & " And [Nr]<6

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

**Foksh** · يناير 24

1 ساعه مضت, كريمو2 said:
والان كيف يتم استنثاء في الشطر 2 من الكوذ
 

ممتاز ، بما أن الجزء الأول قد تم حله ,,
الجزء الثاني جرب هذا التعديل ..

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

**طاهر اوفيسنا** · يناير 24

5 ساعات مضت, Foksh said:

ممتاز ، بما أن الجزء الأول قد تم حله ,,
الجزء الثاني جرب هذا التعديل ..

يبدو ان هناك مشكلة في الاستثناء

myCriteria = "[Nr] < 6"

2025-03-01_14-00-35.jpg.d1150ac7704a417e2634aaaade2da385.jpg

مع العلم ان المشكل يظهر غير في الشرط

If Month(Now()) = 3 Or Month(Now()) = 7

شهر 1 و 2 عادي اما شهر 3 و 7 ففيهما خاصية اقتطاع الانخراط 1500.00 يتم فيه ظهور الميساج ولم يتم اقتطاع المبلغ

20250123.rar

تم تعديل يناير 24 بواسطه كريمو2

**طاهر اوفيسنا** · يناير 24

6 ساعات مضت, ابو عارف said:
myCriteria = myCriteria & " And [Nr]<6

**Foksh** · يناير 24

1 ساعه مضت, كريمو2 said:

شهر 1 و 2 عادي اما شهر 3 و 7 ففيهما خاصية اقتطاع الانخراط 1500.00 يتم فيه ظهور الميساج ولم يتم اقتطاع المبلغ

لم افهم آلية العمل على برنامجك ، ولكن من خلال ما فهمت من تتبع مسار الكود / جرب هذا التعديل . فأنت تعرف مداخل ومخارج مشروعك وكيفية العمل عليه :yes:

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

:excl: مع العلم أنني لم أجد الزر cmd_Pay_installments في النموذج ..

على العموم ، جرب الكود وأخبرني بالنتيجة ..

**ابو عارف** · يناير 24

قد نسيت علاقة تنصيص الاخيرة، جرب هذا

myCriteria = "([detach]='موظف'"
        myCriteria = myCriteria & " Or [detach]='عامل متعاقد توقيت كامل'"
        myCriteria = myCriteria & " Or [detach]='عامل متعاقد توقيت جزئي'"
        myCriteria = myCriteria & " Or [detach]='حارس متعاقد توقيت جزئي'"
        myCriteria = myCriteria & " Or [detach]='عون نظافه وتطهير')"
		myCriteria = myCriteria & " And [Nr]<6"

**طاهر اوفيسنا** · يناير 24

4 ساعات مضت, Foksh said:
لم افهم آلية العمل على برنامجك ، ولكن من خلال ما فهمت من تتبع مسار الكود / جرب هذا التعديل . فأنت تعرف مداخل ومخارج مشروعك وكيفية العمل عليه
 

المشكلة في الشطر الثاني اي يذهب الكود له عند الشهر 3 والشهر 7 لانه فما اقتطاع Inkhiratيساوي 1500.00

الملف اكسل المرفق يوضح

2100.jpg.b755750e4551bafb4ea4f5ae59c6bfa1.jpg

4 ساعات مضت, ابو عارف said:

myCriteria = "([detach]='موظف'"
        myCriteria = myCriteria & " Or [detach]='عامل متعاقد توقيت كامل'"
        myCriteria = myCriteria & " Or [detach]='عامل متعاقد توقيت جزئي'"
        myCriteria = myCriteria & " Or [detach]='حارس متعاقد توقيت جزئي'"
        myCriteria = myCriteria & " Or [detach]='عون نظافه وتطهير')"
		myCriteria = myCriteria & " And [Nr]<6"

استاذي العزيز موضوع الطلب هو تغيير detach بـ Nr

Inkhirat.xlsx

تم تعديل يناير 24 بواسطه كريمو2

**Foksh** · يناير 24

1 ساعه مضت, كريمو2 said:

المشكلة في الشطر الثاني اي يذهب الكود له عند الشهر 3 والشهر 7 لانه فما اقتطاع Inkhiratيساوي 1500.00

الملف اكسل المرفق يوضح

استاذي العزيز موضوع الطلب هو تغيير detach بـ Nr

Inkhirat.xlsx 16.66 kB · 0 downloads

أخي الكريم ، لماذا أشعر بأنك تبخل بالتوضيح بشرح ما يحصل معك وما تحاول الوصول اليه ؟؟؟؟؟

وتقتصر ردودك على صورة وعلى عدم الإجابة عن جميع الأسئلة التي نطرحها محاولةً منا لفهم الذي يحصل معك !!!!!!!!!!!

أخر محاولاتي في فهم ما تريد ما لم تقم بالتوضيح أكثر في مواضيعك وطلباتك :rol:

Private Sub cmd_Pay_installments_Click()
    On Error GoTo err_cmd_Pay_installments_Click

    Dim rst As DAO.Recordset
    Dim rstE As DAO.Recordset
    Dim myCriteria As String
    Dim TheSum As Double
    Dim Rc As Long
    Dim i As Long
    Dim a1 As Long
    Dim a2 As Long
    Dim PaymentMonth As Long

    PaymentMonth = CLng(DateSerial(Year(Me.txtMonth), Month(Me.txtMonth), 1))

    Set rst = CurrentDb.OpenRecordset("Select * From tbl_Loans Where [Payment_Month]=#" & Format(Me.txtMonth, "MM/DD/YYYY") & "#")
    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
    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

                If Month(Now()) = 3 Or Month(Now()) = 7 Then
                    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]=#" & Format(Me.txtMonth, "MM/DD/YYYY") & "#"
                        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

**طاهر اوفيسنا** · يناير 24

1 ساعه مضت, Foksh said:

خي الكريم ، لماذا أشعر بأنك تبخل بالتوضيح بشرح ما يحصل معك وما تحاول الوصول اليه ؟؟؟؟؟

وتقتصر ردودك على صورة وعلى عدم الإجابة عن جميع الأسئلة التي نطرحها محاولةً منا لفهم الذي يحصل معك !!!!!!!!!!!

أخر محاولاتي في فهم ما تريد ما لم تقم بالتوضيح أكثر في مواضيعك وطلباتك

فكيف ابخل عليك استاذي الكريم وأنا في أمس الحاجة الى الحل النموذجي الصحيح

الكود به مشكلة بعد هذا الشرط

If Month(Now()) = 3 Or Month(Now()) = 7

اولا : الكود عبارة عن جزئين

الجزء الاول :هو اقتطاع القروض والكهرومنزلية خلال السنة باستثناء Nr اكبر او يساوي 6 تم الحل والحمد لله

الجزء الثاني : هو اقتطاع الانخراط والمقدر ب 3000 للسنة خلال شهري مارس وجويلية كل على حدى بمبلغ 1500

خلال هاذين الشهرين يستمر انقطاع الواقع في الجزء الاول

هنا وهو بيت القصيد يستنى Nr<6 "رقم الوظيفة" من انقطاع الانخراط والمقدر ب 1500 يعني الكود لايضيف سجل لهذه الفئة

ملاحظة : المنخرط رقم 81 ورقم وظيفته 9 الذي استثني من اقتطاع القروض هنا ايضا يستنى من انقطاع الانخراط

انظر ليس لديه سجل بالاحمر في الصورة

image.png.fb11c0bb4d22baf39bcb42e625b08384.png

تم تعديل يناير 24 بواسطه كريمو2

**طاهر اوفيسنا** · يناير 25

للرفع

**طاهر اوفيسنا** · يناير 25

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

تم تعديل يناير 25 بواسطه كريمو2

**طاهر اوفيسنا** · يناير 26

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

تم تعديل يناير 26 بواسطه كريمو2

**طاهر اوفيسنا** · يناير 26

للرفع

**ناقل** · يناير 26

8 ساعات مضت, كريمو2 said:

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

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

**طاهر اوفيسنا** · يناير 26

59 دقائق مضت, ناقل said:

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

شكرا استاذ على الالتفاتة الطيبة

موضوع وهو تعديل على كود اقتطاع الانخراط

بالاصح العامل الذي يدفع المبلغ 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

**ناقل** · يناير 26

28 دقائق مضت, كريمو2 said:

وضوع وهو تعديل على كود اقتطاع الانخراط

انا فتحت النموذج طيب بعدين .... كيف يعمل برنامجك .... لكي نرى النتيجة ؟؟؟؟؟؟؟؟؟؟؟؟

في حال محاولة التشغيل يتوقف على Abou_Taha

مما هذه ؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟

**طاهر اوفيسنا** · يناير 26

13 دقائق مضت, ناقل said:

انا فتحت النموذج طيب بعدين .... كيف يعمل برنامجك .... لكي نرى النتيجة ؟؟؟؟؟؟؟؟؟؟؟؟

غير تاريج الجهاز الى شهر مارس وافتح الفورم سترى النتيجة

عندها اذهب الى الجدول tbl_Loans واغمل الفلترة للعامل 89 كعينة

سترى انقطاع القروص المبلغ المقتطع = 5000

ودفع الانخراط في المبلغ المقتطع = 3000

والمبلغ المقتطع الذي تم تلقائيا هو = 1500 وهذا الاخير هو المطلوب لازم مايكون

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

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

تم تعديل يناير 26 بواسطه كريمو2

**طاهر اوفيسنا** · يناير 26

55 دقائق مضت, ناقل said:

في حال محاولة التشغيل يتوقف على Abou_Taha

مما هذه ؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟

التقارير عير موجودة

الكود عند Private Sub cmd_Pay_installments_Click()

ثم الى الجدول tbl_Loans مباشرة

**ناقل** · يناير 26

1 ساعه مضت, طاهر اوفيسنا said:

غير تاريج الجهاز الى شهر مارس وافتح الفورم سترى النتيجة

عندها اذهب الى الجدول tbl_Loans واغمل الفلترة للعامل 89 كعينة

سترى انقطاع القروص المبلغ المقتطع = 5000

ودفع الانخراط في المبلغ المقتطع = 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  '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
                        ' استثناء الموظف الذي دفع 3000
                        If Nz(DLookup("Payment_Made", "tbl_Loans", "EmployeeID=" & rstE!EmployeeID & " And [Payment_Made]=3000 And [Payment_Month]=#" & Me.txtMonth & "#"), 0) <> 3000 Then
                            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
                        End If
                        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

**طاهر اوفيسنا** · يناير 26

لاحظ الصورة استاذ

يبدو ان الكود بقي على حالة اي اضاف سجل جديد بينما قام بحذف مبلغ 3000

2025-03-01_21-29-26.jpg.56031b7acfeafc5becdb1688fe3009ec.jpg

**طاهر اوفيسنا** · يناير 26

استاذ يبدو الخلبطة عندي غدا سأجربه في البرنامج الرئيسي واوافيك الرد

**طاهر اوفيسنا** · يناير 26

فهلا لقد تم التجريب الان مازال الكود يضيف سجل جديد بالنسبة للمنخرط الى دافع 3000

للعلم استاذ

ان الحقل Loan_Made خاص بمبالغ القروض ويكون فارغا بالنسبة لمبلغ الانخراط

تسجيل الدخول

الاقتطاع الشهري لمبالغ مالية بإستناء

الردود الموصى بها

طاهر اوفيسنا

Foksh

طاهر اوفيسنا

ابو عارف

Foksh

طاهر اوفيسنا

طاهر اوفيسنا

Foksh

ابو عارف

طاهر اوفيسنا

Foksh

طاهر اوفيسنا

طاهر اوفيسنا

طاهر اوفيسنا

طاهر اوفيسنا

طاهر اوفيسنا

ناقل

طاهر اوفيسنا

ناقل

طاهر اوفيسنا

طاهر اوفيسنا

ناقل

طاهر اوفيسنا

طاهر اوفيسنا

طاهر اوفيسنا

Join the conversation

تصفح هذا الموضوع مؤخراً 0 اعضاء متواجدين الان

تصفح الموقع

تصفح جديد الموقع

Support

Important Information