كود الوزن النسبي لايام العمل لكل عامل مضروباً في صافي قيمة المستخلص

السلام عليكم

اذا كان هناك عدم وضوح في الطلب برجاء الافادة 

شاكر لكم تعاونكم ...

السلام عليكم ..

للأسف لا استخدم هذا الأصدار 

فقط استخدم اصدار 2003

وأنا كذلك مثل فتى الوادي

السلام عليكم

اشكركم على سرعة الاستجابة تم رفع نفس الملف ولكن بصيغة اكسيس 2003

تفضلوا

مستخلص 2003.rar

اخي ابو علاء :)

ياريت تعمل صورة للنموذج وتخبرنا عن الحقول اللي لازم نساعدك فيها (الاسماء لا تكفي) ، لاني ما قدرت اميز بين الحقول في النموذج الرئيسي والحقول في النموذج الفرعي :(

جعفر

يرجى توضيح العبارة "عدد أيام العمل / إجمالي الأيام"

مالفرق بين عدد أيام العمل و إجمالي الأيام ؟ .

استاذي الكريم / جعفر 

اليكم الصورة بالايضاح

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

اي ان نصيب العامل = (عدد ايام عمله / اجمالي يوميات العمال بالكامل ) * صافي قيمة المستخلص 

المستحق  لمحمود = عدد يومياته ( 1 ) / اجمالي عدد اليوميات (3 ) ) * صافي قيمة المستخلص ( 90000) 

ليكون الناتج = 30000

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

الفرق بين

عدد الايام المقصود بها عدد ايام العمل لكل عامل على حده 

اما الاجمالي هو اجمالي ايام كل العمال والموجود اسفل الجدول في حقل نصي ....

تفضل :)

1. احذف الكود في الحقل E:

2. استعمل الكود التالي (على حدث تغيير الايام):

Private Sub days_AfterUpdate()
On Error GoTo err_days_AfterUpdate

    Dim E_Temp, i As Integer
    'Dim rst As DAO.Recordset
    
    If Me.Dirty Then Me.Dirty = False
    
    E_Temp = 0
    Set rst = Me.RecordsetClone
    rst.MoveLast: rst.MoveFirst
    
    For i = 1 To rst.RecordCount
        E_Temp = E_Temp + rst![days]
        rst.MoveNext
    Next i
    
    Me.E = E_Temp
    Me.amount = (Me.days / Me.E) * Me.Parent.d
    
Exit Sub
err_days_AfterUpdate:

    If Err.Number = 3021 Then
        'ingor
        Resume Next
    Else
        MsgBox Err.Number & vbCrLf & Err.Description
    End If
    
End Sub

Private Sub Form_Current()

    Call days_AfterUpdate
End Sub

جعفر

234.مستخلص 2003.mdb.zip

استاذي الفاضل / جعفر 

السلام عليكم

اريد بعد كل عملية ادخال جديد في اسماء العمال ان يتم اعادة توزيع ال 90000 ريال على كل عامل من جديد كل حسب عدد ايامه ...

معلش ازعجتك ... بارك الله فيك ..

اساتذتي الكرام واستاذي الجليل / جعفر

السلام عليكم

حتى لا أثقل عليكم واريحكم من الجهد والعناء وجب التنويه على اني الحمد لله تلقيت حل للمشكلة بطريقة تتوافق مع طلبي على موقع اوفسينا من استاذي الكريم / علي المصري

واشكركم جميعاً اساتذتي واعضاء ومديري الموقع الموقر ..

على الرابط التالي ...

http://www.officena.net/ib/index.php?s=685d173d85ad6de857b645bfbf33e058&showtopic=54990

تحياتي للجميع ... 

اخي ابوالعلا

alaaaboulela كتب:

 

اريد بعد كل عملية ادخال جديد في اسماء العمال ان يتم اعادة توزيع ال 90000 ريال على كل عامل من جديد كل حسب عدد ايامه ...

انت لم تخبرنا عن هذه الجزئية !!

وشكرا على تفضلك على مشاركتك الاخيرة ، والحمدلله انك حصلت على ما تريد ، وقد اخذني الفضول وذهبت الى الرابط الذي ارفقته لكي ارى الجواب ، ولدي ملاحظتين على الجواب:

1. خانة المستحق Amount لا تُحفظ في الجدول الآن ، وعند احتياجك لها في التقارير او اي شئ آخر ، فيجب عليك القيام بهذه العملية من اول وجديد لكل سجل ،

2. عند تغييرك عدد الايام للعامل ، فقيمة المستحق لا تتغير إلا بعد بعد ان تنتقل لسجل آخر.

جعفر

إذن فما الحل من وجهة نظرك استاذي الكريم ...

انا عارف اني تعبتك معاي ربنا يجعله في ميزان حسناتك ....

بخصوص جزئية الاعلام باعادة التوزيع كانت تنقص للتوضيح اكثر وكانت ضمنا في الصورة داخل المربع الأحمر واعادة حساب المستحق للعامل بعد كل تحديث 

في المشاركة رقم 8 واعتذر عن سوء عرض المشكلة او الاخفاق في صياغة الطلب ...

تفضل

وهذا هو الكود الجديد والذي به تغيير قيمة المستحقين كذلك:

Private Sub days_AfterUpdate()
On Error GoTo err_days_AfterUpdate

    Dim E_Temp, i As Integer
    'Dim rst As DAO.Recordset
    
    If Me.Dirty Then Me.Dirty = False
    
    E_Temp = 0
    Set rst = Me.RecordsetClone
    rst.MoveLast: rst.MoveFirst
    
    For i = 1 To rst.RecordCount
        E_Temp = E_Temp + rst![days]
        rst.MoveNext
    Next i
    
    Me.E = E_Temp
    rst.MoveFirst
    
    For i = 1 To rst.RecordCount
        rst.Edit
        rst!amount = (rst!days / Me.E) * Me.Parent.d
        rst.Update
        rst.MoveNext
    Next i
    
    
Exit Sub
err_days_AfterUpdate:

    If Err.Number = 3021 Then
        'ingor
        Resume Next
    Else
        MsgBox Err.Number & vbCrLf & Err.Description
    End If
    
End Sub

جعفر

234.مستخلص 2003.mdb.zip

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

ملك الاكواد ... :)

حياك الله :)

وحياك استاذي ... :D  :ty: