اذهب الي المحتوي
أوفيسنا

كود لتطبيق السداد عل ى اكثر من سجل بضغطة زر واحدة


رشبد
إذهب إلى أفضل إجابة Solved by Moosak,

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

السلام علكم ورحمة الله

جزى الله كل من مر مرور الكرام      

    اريد كود  عند ادخال مبلغ المسدد في المربع  تم ضغطة زر سداد قوم البرنامج بادخال اقيمة rest في pye شرط ان يكون المبلغ المسدد اكبر من لي في   rest ويعمل تشيك  ل valider     ويمر الى الخانة الموالية  ونفس العملية يعني حلقة تكرارية  لادخل pye حسب المبلغ المسدد

 

 

pye.accdb

تم تعديل بواسطه رشبد
رابط هذا التعليق
شارك

  • أفضل إجابة

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

كتبت لك كود يراعي أن يكون المبلغ المدفوع أقل من أو يساوي المدفوع 

وكذلك الكود يكمل على الدفع السابق في حال أنه تم دفع جزء من المبلغ سابقا..

image.gif.e252b8062063883032563b29049fb0f7.gif

تفضل هذا هو الكود :

Private Sub Command6_Click()
    Dim PayedAmount As Double, Amount As Double, Remaining As Double
    Dim RS As DAO.Recordset
    Dim SQl As String
    
    PayedAmount = Nz(Me.Text4, 0)
    If PayedAmount = 0 Then MsgBox "أدخل المبلغ": Exit Sub
    
    Remaining = Nz(DSum("rest", "Table1", "cod = " & [Forms]![Form1]![sh]), 0)
    If PayedAmount > Remaining Then MsgBox "المبلغ المدفوع أكبر من المبلغ المتبقي للسداد": Exit Sub
    
    SQl = "SELECT * FROM Table1 WHERE Table1.rest > 0 AND Table1.cod = " & [Forms]![Form1]![sh]
    
    Set RS = CurrentDb.OpenRecordset(SQl)
    
    Do While Not RS.EOF
        
        RS.Edit
        
        If PayedAmount >= RS.Fields("rest") Then
            Amount = RS.Fields("rest").Value
            RS.Fields("pye").Value = RS.Fields("pye").Value + RS.Fields("rest")
            If RS.Fields("rest").Value = 0 Then RS.Fields("valider").Value = True
            PayedAmount = PayedAmount - Amount
        Else
            RS.Fields("pye").Value = RS.Fields("pye").Value + PayedAmount
            If RS.Fields("rest").Value = 0 Then RS.Fields("valider").Value = True
            PayedAmount = 0
        End If
        
        RS.Update
        
        If PayedAmount = 0 Then Exit Do
        RS.MoveNext
    Loop
    
    Me.w.Requery
    MsgBox "Done"
    
    Set RS = Nothing
End Sub

 

pye.accdb

  • Like 2
رابط هذا التعليق
شارك

من فضلك سجل دخول لتتمكن من التعليق

ستتمكن من اضافه تعليقات بعد التسجيل



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

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information