دمج كود شرطي

**طاهر اوفيسنا** · أغسطس 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

**طاهر اوفيسنا** · أغسطس 23, 2017

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

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

**طاهر اوفيسنا** · أغسطس 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

تسجيل الدخول

دمج كود شرطي

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

طاهر اوفيسنا

طاهر اوفيسنا

طاهر اوفيسنا

Join the conversation

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

تصفح الموقع

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

Support

Important Information