توزيع مبلغ القسط بدون كسور

[mostafaatiya]

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

اخوتي في الله 

الملف المرفق به جدولين 

جدول للبيانات العملاء 

وجدول لبيانات الاقساط

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

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

لو هوزع مبلغ 17000 علي 12 شهر = 1416.66666666667

ولو وزعت المبلغ 17000 علي 18 شهر = 944.444444444444

ولو وزعت المبلغ 17000 علي 24 شهر = 708.333333333333

انا طالب من حضرتك ان يتم توزيع المبلغ بدون كثور يعني مثلا لو هوزع علي 12 شهر يكون القسط 1400 

اصبح عندي 16.66 * 12 = 199.92 + 1416.66 = 1,616.58 يكون ده القسط الاخير 

يعني يجمع كل الفروق ويضعها في القسط الاخير

هو انا مش عارف هتنفع ولا لاء بس بقول ممكن الفكرة تتنفذ وممكن لاء 

وشكرا جدا لحضرتكم

توزيع المبلغ بشرط.accdbFetching info...

[محمد أبوعبدالله]

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

تفضل اخي الكريم

اولاً استخدمنا الوحدة النمطية لتقريب المبلغ عند التقسيم

Public Function XRnd(strnr As Double) As Integer
Dim myrnd, X As Double, newrnd As Double

    X = strnr \ 100
    newrnd = X * 100
    myrnd = strnr - newrnd
    XRnd = newrnd

End Function

ثم قمنا بتحديد القسط الشهري وباقي المبلغ من الكود التالي

        Dim X As Integer, X1 As Integer
        Me.amount = XRnd([totalamount] / [coden])
        X = XRnd([totalamount] / [coden]) * coden
        X1 = totalamount - X

وقمنا بالتوزيع بالشكل التالي

        mySQL = "Select * From Sharevalue"
        Debug.Print mySQL
        Set rst = CurrentDb.OpenRecordset(mySQL)
        
        For i = 1 To Me.coden
            rst.AddNew
            rst!codec = Me.codec
            rst!amount = Me.amount
            rst!coden = i
            rst.Update
        Next i

ثم تحديث قيمة اخر قسط كالتالي

        mySQL1 = "Select * From Sharevalue"
        mySQL1 = mySQL1 & " WHERE  coden = " & Me.coden
        Debug.Print mySQL1
        Set rst1 = CurrentDb.OpenRecordset(mySQL1)
         rst1.MoveLast

         For i = Me.coden To Me.coden
            rst1.Edit
            rst1!amount = rst1!amount + X1
            rst1.Update
            Form_datac.Sharevalue.Requery
        Next i

توزيع المبلغ بشرط.rarFetching info...

تحياتي

تم تعديل أغسطس 11, 2020 بواسطه محمد أبوعبدالله

[mostafaatiya]

  في 11‏/8‏/2020 at 03:59, محمد أبوعبدالله said:

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

تفضل اخي الكريم

اولاً استخدمنا الوحدة النمطية لتقريب المبلغ عند التقسيم

Public Function XRnd(strnr As Double) As Integer
Dim myrnd, X As Double, newrnd As Double

    X = strnr \ 100
    newrnd = X * 100
    myrnd = strnr - newrnd
    XRnd = newrnd

End Function

ثم قمنا بتحديد القسط الشهري وباقي المبلغ من الكود التالي

        Dim X As Integer, X1 As Integer
        Me.amount = XRnd([totalamount] / [coden])
        X = XRnd([totalamount] / [coden]) * coden
        X1 = totalamount - X

وقمنا بالتوزيع بالشكل التالي

        mySQL = "Select * From Sharevalue"
        Debug.Print mySQL
        Set rst = CurrentDb.OpenRecordset(mySQL)
        
        For i = 1 To Me.coden
            rst.AddNew
            rst!codec = Me.codec
            rst!amount = Me.amount
            rst!coden = i
            rst.Update
        Next i

ثم تحديث قيمة اخر قسط كالتالي

        mySQL1 = "Select * From Sharevalue"
        mySQL1 = mySQL1 & " WHERE  coden = " & Me.coden
        Debug.Print mySQL1
        Set rst1 = CurrentDb.OpenRecordset(mySQL1)
         rst1.MoveLast

         For i = Me.coden To Me.coden
            rst1.Edit
            rst1!amount = rst1!amount + X1
            rst1.Update
            Form_datac.Sharevalue.Requery
        Next i

توزيع المبلغ بشرط.rar 34.54 kB · 7 تنزيلات

تحياتي

Expand  

الف الف شكر لحضرتك تم الافادة ربنا يبارك في حضرتك