دمج كود شرطي

**كريمو2** · أغسطس 21, 2017

السلام عليكم اخواني الأساتذة

ان شاء الله تكونو بالف خير يارب

المطلوب اضافة هذا الكود الشرطي

    Me.Payment_Made_Cridi = Me.Loan_Cridi
    Me.sadad = Me.Loan_Cridi
    If Me.sadad.Value = True Then
Me.wada3 = "تم التسديد"
Else
Me.wada3 = "لم يتم التسديد"
End If
DoCmd.RunCommand acCmdSaveRecord
Forms!frm_Loans!txt1.Requery
Forms!frm_Loans!txt2.Requery

الى هذا

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]=#" & Me.txtMonth & "#")
    rst.MoveLast: rst.MoveFirst
    RC = rst.RecordCount
    a1 = 0  'just a flag
    a2 = 0  'jusf a flag
    
    For I = 1 To RC
        
        rst.Edit
            
            'check, maybe a manual payment is done, so don't over write it
            If Len(rst!Payment_Made_Cridi & "") = 0 And Not IsNull(rst!Loan_Cridi) Then
                rst!Payment_Made_Cridi = rst!Loan_Cridi
                a1 = 1
            End If
            
            If Len(rst!Payment_Made_Elec & "") = 0 And Not IsNull(rst!Loan_Elec) Then
                rst!Payment_Made_Elec = rst!Loan_Elec
                a1 = 1
            End If
            
        rst.Update
        
        rst.MoveNext
    Next I

'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
        
            'check if payment is already entered, if it is, then skip this Record
            rst.FindFirst "[Loan_Type]='Other' 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!Loan_AwardMonth = Me.AwardMonth
                rst!Payment_Month = DateSerial(Year(Me.txtMonth), Month(Me.txtMonth), 1)
                'rst!Loan_Cridi = Me.txtDiscountPerMonth
                'rst!Loan_Elec=         'to be used in Elec loan Form
                rst!Loan_Other = 1000      'to be used in Other loan Form
                'rst!Payment_Made =     'to be used each time a pyment is made
                rst!Loan_Type = "Other"
                rst!Remarks = "خصم من الراتب لإشتراك شهر " & Year(Me.txtMonth) & "/" & Month(Me.txtMonth)
        
              rst.Update
            
            End If
            
            rstE.MoveNext
            
        Next I
        rstE.Close: Set rstE = Nothing
        
    End If
    
I_am_Done:
    
    
    'clean up
    rst.Close: Set rst = Nothing


    'show this message only if data are entered
    If a1 = 1 Or a2 = 1 Then
        MsgBox "هل تريد أن يتم توزيع الإقتطاعات لهذا الشهر " & Me.txtMonth
        
    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

2017-08-21_11-25-43.png.1065efa7cb4383840333851339472c1b.png

**كريمو2** · أغسطس 23, 2017

الحمد لله على عودة المنتدى

. اين المساعدة

**كريمو2** · أغسطس 25, 2017

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

تم الحل

اعرف انكم مابخلتم غني ولكن ربما مافهمتم المطلوب

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]=#" & Me.txtMonth & "#")
    rst.MoveLast: rst.MoveFirst
    RC = rst.RecordCount
    a1 = 0  'just a flag
    a2 = 0  'jusf a flag
    
    For I = 1 To RC
        
        rst.Edit
            
            'check, maybe a manual payment is done, so don't over write it
            If Len(rst!Payment_Made_Cridi & "") = 0 And Not IsNull(rst!Loan_Cridi) Then
                rst!Payment_Made_Cridi = rst!Loan_Cridi
                rst!sadad = rst!Loan_Cridi
                If rst!sadad.Value = True Then
                rst!wada3 = "تم التسديد"
                Else
                rst!wada3 = "لم يتم التسديد"
                End If
                a1 = 1
            End If
            
            If Len(rst!Payment_Made_Elec & "") = 0 And Not IsNull(rst!Loan_Elec) Then
                rst!Payment_Made_Elec = rst!Loan_Elec
                a1 = 1
            End If
            
        rst.Update
        
        rst.MoveNext
    Next I

'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
        
            'check if payment is already entered, if it is, then skip this Record
            rst.FindFirst "[Loan_Type]='Other' 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!Loan_AwardMonth = Me.AwardMonth
                rst!Payment_Month = DateSerial(Year(Me.txtMonth), Month(Me.txtMonth), 1)
                'rst!Loan_Cridi = Me.txtDiscountPerMonth
                'rst!Loan_Elec=         'to be used in Elec loan Form
                rst!Loan_Other = 1000      'to be used in Other loan Form
                'rst!Payment_Made =     'to be used each time a pyment is made
                rst!Loan_Type = "Other"
                rst!Remarks = "خصم من الراتب لإشتراك شهر " & Year(Me.txtMonth) & "/" & Month(Me.txtMonth)
        
              rst.Update
            
            End If
            
            rstE.MoveNext
            
        Next I
        rstE.Close: Set rstE = Nothing
        
    End If
    
I_am_Done:
    
    
    'clean up
    rst.Close: Set rst = Nothing


    'show this message only if data are entered
    If a1 = 1 Or a2 = 1 Then
        MsgBox "هل تريد أن يتم توزيع الإقتطاعات لهذا الشهر " & Me.txtMonth
        
    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

تسجيل الدخول

دمج كود شرطي

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

كريمو2

رابط هذا التعليق

شارك

كريمو2

رابط هذا التعليق

شارك

كريمو2

رابط هذا التعليق

شارك

Join the conversation

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

تصفح الموقع

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

Support

Important Information