التعديل الاخير لكود الاقتطاع لم يلبي الرغبات 100%

[أبوبسمله]

5 دقائق مضت, طاهر اوفيسنا said:

نتمنى من يجد لي حلا في القريب  العاجل لاني ملزم بدفع الاقتطاع الخاص بشهر مارس في اقرب وقت

اتمنى ان يجد احد الاخوه او الاساتذه حلا لك لانى بصراحه مش قادر افهم الموضوع كاملا وحاسس بتوهان فيه

تمنياتى لك وللجميع بالتوفيق

[طاهر اوفيسنا]

5 دقائق مضت, أبوبسمله said:

اتمنى ان يجد احد الاخوه او الاساتذه حلا لك لانى بصراحه مش قادر افهم الموضوع كاملا وحاسس بتوهان فيه

الموضوع ساهل استاذ ولكن يمكن الفكرة لم تصل اليك

[Foksh]

باعتقادي وبأنه الكثير لم يفهم تسلسل ولا آلية ولا فكرة المرفق أو كيفية فهم النتائج في هذا المشروع ، اعتقد إنه يتوجب عليك أخي @طاهر اوفيسنا إعادة النظر في الآلية التي تسير بها في مشروعك . هذا من ناحية طبعاً .

من ناحية أخرى ما زلت تفتقر الى الشرح المبسط أو الواضح وتوصيل المعلومة التي من خلالها نستطيع فهم ما تريده . وليس تزويدنا بكود وصورة قد يكون كافياً دائماً لفهم المطلوب . على العموم ، جرب هذا التعديل في النهج كاملاً ..

Private Sub cmd_Pay_installments_Click()
On Error GoTo err_cmd_Pay_installments_Click

Dim rst As DAO.Recordset
Dim rstE As DAO.Recordset
Dim Rc As Integer, TheSum As Double
Dim myCriteria As String

Set rst = CurrentDb.OpenRecordset("SELECT * FROM tbl_Loans WHERE [Payment_Month]=#" & Format(Me.txtMonth, "mm/dd/yyyy") & "#")

If rst.EOF Then
    MsgBox " لا توجد إقتطاعات لشهر " & Format(Me.txtMonth, "mmmm yyyy"), vbInformation
    rst.Close: Set rst = Nothing
    Exit Sub
End If

With rst
    If IsNull(!Payment_Made) And Not IsNull(!Loan_Made) Then
        If MsgBox("هل تريد توزيع الإقتطاعات لشهر " & Format(Me.txtMonth, "mmmm yyyy") & "؟", vbYesNo + vbQuestion) = vbYes Then
            
            Do Until .EOF
                .Edit
                If !Nr >= 6 Then
                    !Payment_Made = 0
                ElseIf !Loan_Type = "Cridi" Or !Loan_Type = "Elec" Then
                    !Payment_Made = !Loan_Made
                    !sadad = !Loan_Made
                    !Loan_Remise = 0
                End If
                
                !wada3 = IIf(Nz(!sadad, 0) <> 0, "تم التسديد", "لم يتم التسديد")
                TheSum = TheSum + Nz(!Payment_Made, 0)
                .Update
                .MoveNext
            Loop
            
            ' اقتطاع الانخراط في مارس ويوليو
            If Month(Me.txtMonth) = 3 Or Month(Me.txtMonth) = 7 Then
                myCriteria = "([detach] IN ('موظف', 'عامل متعاقد توقيت كامل', 'عامل متعاقد توقيت جزئي', 'حارس متعاقد توقيت جزئي', 'عون نظافه وتطهير'))"
                Set rstE = CurrentDb.OpenRecordset("SELECT * FROM Employee WHERE " & myCriteria)

                If Not rstE.EOF Then
                    Do Until rstE.EOF
                        If DCount("*", "tbl_Loans", "EmployeeID=" & rstE!EmployeeID & " AND [Loan_Type]='Inkhirat' AND [Payment_Month]=#" & Me.txtMonth & "#") = 0 Then
                            .AddNew
                            !EmployeeID = rstE!EmployeeID
                            !Loan_ID = 0
                            !Payment_Month = Me.txtMonth
                            !Payment_Made = DLookup("Other_Value", "TblOther", "ID=1")
                            !Loan_Type = "Inkhirat"
                            !Nr = GetNumDetach(rstE!EmployeeID)
                            !Remarks = "إقتطاع من الراتب لإنخراط شهر " & Format(Me.txtMonth, "yyyy/mm")
                            !sadad = !Payment_Made
                            !wada3 = "تم الإنخراط"
                            .Update
                            TheSum = TheSum + Nz(!Payment_Made, 0)
                        End If
                        rstE.MoveNext
                    Loop
                End If
                rstE.Close: Set rstE = Nothing
            End If

            ' عرض المجموع النهائي
            MsgBox "تم توزيع الإقتطاعات بنجاح." & vbCrLf & "المجموع: " & Format(TheSum, "#,##0.00"), vbInformation, "إقتطاعات شهر " & Format(Me.txtMonth, "mmmm yyyy")
        End If
    End If
End With

rst.Close: Set rst = Nothing
Exit Sub

err_cmd_Pay_installments_Click:
    MsgBox "خطأ رقم: " & Err.Number & vbCrLf & Err.Description, vbCritical
    If Not rst Is Nothing Then rst.Close: Set rst = Nothing
    If Not rstE Is Nothing Then rstE.Close: Set rstE = Nothing
End Sub

 

الكود في ملف نصي مضغوط ..

 

Text_VBA.zip

تم تعديل الثلاثاء at 12:09 بواسطه Foksh
إضافة ملف نصي للكود ، بناءً على طلب صاحب الموضوع

[طاهر اوفيسنا]

ممكن ارساله في ملفtxt لاني بالمبايل ولايمكن لي نسخ الكود ووضعه بالكمبيوتر وهذا الاخير بدون نات

[Foksh]

3 دقائق مضت, طاهر اوفيسنا said:

ممكن ارساله في ملفtxt

تم الإضافة في المشاركة السابقة أخي الكريم ,,

[طاهر اوفيسنا]

شكرا استاذ على الاهتمام التعديل مزال فيه مشاكل لاحظ الصورة بتمعن

[Barna]

14 ساعات مضت, طاهر اوفيسنا said:

استاذ نفس المشكلة

ياريت ترى مشكلة الكود بالمرفق ادناه

جرب المرفق التالي

 

BAR_1.mdb

قم بمسح الاقتطاعات السابقة 

[Foksh]

7 دقائق مضت, طاهر اوفيسنا said:

شكرا استاذ على الاهتمام التعديل مزال فيه مشاكل لاحظ الصورة بتمعن

حسناً ، جرب هذا التعديل ، حيث استخدمنا Do Until بدلاً من Continue For ..

If Month(Me.txtMonth) = 3 Or Month(Me.txtMonth) = 7 Then
    myCriteria = "([detach] IN ('موظف', 'عامل متعاقد توقيت كامل', 'عامل متعاقد توقيت جزئي', 'حارس متعاقد توقيت جزئي', 'عون نظافه وتطهير'))"
    Set rstE = CurrentDb.OpenRecordset("SELECT * FROM Employee WHERE " & myCriteria)

    If Not rstE.EOF Then
        Do Until rstE.EOF
            If DCount("*", "tbl_Loans", "EmployeeID=" & rstE!EmployeeID & " AND [Loan_Type]='Inkhirat' AND [Payment_Month]=#" & Me.txtMonth & "#") = 0 Then
                rst.AddNew
                rst!EmployeeID = rstE!EmployeeID
                rst!Loan_ID = 0
                rst!Payment_Month = Me.txtMonth
                rst!Payment_Made = DLookup("Other_Value", "TblOther", "ID=1")
                rst!Loan_Type = "Inkhirat"
                rst!Nr = GetNumDetach(rstE!EmployeeID)
                rst!Remarks = "إقتطاع من الراتب لإنخراط شهر " & Format(Me.txtMonth, "yyyy/mm")
                rst!sadad = rst!Payment_Made
                rst!wada3 = "تم الإنخراط"
                rst.Update
                TheSum = TheSum + Nz(rst!Payment_Made, 0)
            End If
            rstE.MoveNext
        Loop
    End If
    rstE.Close: Set rstE = Nothing
End If

 

 

 

[طاهر اوفيسنا]

3 ساعات مضت, Barna said:

جرب المرفق التالي

 

BAR_1.mdb 1.27 \u0645\u064a\u062c\u0627 \u0628\u0627\u064a\u062a · 4 downloads

قم بمسح الاقتطاعات السابقة

مبدئيا هذا هو المطلوب استاذ أتمنى ان لا ارى مشكل في شهر جويلية القادم شكرا والف شكرا استاذ  يبدو انك اختزلت الكود استاذ ي العزيز Barna

[طاهر اوفيسنا]

6 ساعات مضت, Barna said:

جرب المرفق التالي

 

استاذ لماذا وظفت زوج MsgBox

                The_Sum = Format(The_Sum, "#,##0.00")
                MsgBox "تم توزيع الإقتطاعات" & vbCrLf & vbCrLf & "مجموع الإقتطاعات = " & The_Sum, , "إقتطاعات شهر " & FrenchMonth(Month(Now())) & SelectedYear
                End If

                The_Sum = Format(The_Sum, "#,##0.00")
                MsgBox "            " & "تم توزيع الإقتطاعات" & vbLf & vbLf & "مجموع الإقتطاعات =  " & The_Sum, , "إقتطاعات شهر" & FrenchMonth(Month(Date)) & Year(Date)

 

[Barna]

في 18‏/2‏/2025 at 22:27, طاهر اوفيسنا said:

استاذ لماذا وظفت زوج MsgBox

هذه بارك الله فيك نتيجة التجارب العديدة .... امسح المسج الاخير ....

[طاهر اوفيسنا]

12 دقائق مضت, Barna said:

هذه بارك الله فيك نتيجة التجارب العديدة .... امسح المسج الاخير

لقد وقفت الاولى فظهر الميساجMsgBox بدون مبلغ مالي استاذ ممكن اعرف كيف اختصرت الكود وهل يعمل بشكل عادي عند بقية الشهور وخاصة عند دفع مبلغ الانخراط بعد مارس

تم تعديل الثلاثاء at 20:30 بواسطه طاهر اوفيسنا

[طاهر اوفيسنا]

 استاذ Barna لقيت مشكل في MsgBox الاخر الي يعلمك بانه تم توزيع الاقتطاعات ومجموع الاقتطاعات يكون ناقص على المجموع الحقيقي في الجدول مثلا المجموع في الجدول القروض =344000.00 والانخراطات =247500.00 يعني المجموع الكلي يساوي 591.500.00

[Barna]

6 ساعات مضت, طاهر اوفيسنا said:

القروض =344000.00 والانخراطات =247500.00 يعني المجموع الكلي يساوي 591.500.00

طيب جرب المرفق بعد مسح بيانات الانخراطات والقروض .............

 

BAR_2.mdb

[طاهر اوفيسنا]

27 دقائق مضت, Barna said:

طيب جرب المرفق بعد مسح بيانات الانخراطات والقروض .............

للأسف MsgBoxلم يظهر المجموع الصحيح وهو 588.500.00 حسب المرفق المعدل اليوم من طرفك بل اظهر مبلغ  115.900.00 منعرف الكود من أين اتى به ؟

تم تعديل الأربعاء at 14:51 بواسطه طاهر اوفيسنا

[أبوبسمله]

في 18‏/2‏/2025 at 13:28, طاهر اوفيسنا said:

الموضوع ساهل استاذ ولكن يمكن الفكرة لم تصل اليك

وبما ان الموضوع سهل لما اخذ كل هذا النقاش اخى الفاضل ولم لم تحله بالاستعلامات قبل الكود وبعد ذلك تحولها لاكواد

في 18‏/2‏/2025 at 13:56, Foksh said:

باعتقادي وبأنه الكثير لم يفهم تسلسل ولا آلية ولا فكرة المرفق أو كيفية فهم النتائج في هذا المشروع

هذا صحيح وكنت ناوى ابدا معه من الصفر تانى واستخدام الاستعلامات العاديه قبل الاكواد ولكنصدمنى برده المختصر السهل والحمدلله  اخى محمد @Barna جزاه الله خيرا قصر علينا الطريق

في 18‏/2‏/2025 at 17:42, طاهر اوفيسنا said:

مبدئيا هذا هو المطلوب استاذ أتمنى ان لا ارى مشكل في شهر جويلية القادم شكرا والف شكرا استاذ  يبدو انك اختزلت الكود استاذ ي العزيز Barna

ولم الانتظار قم باخذ نسخه للتجربه وقدم تاريخ الجهاز وجرب حتى يتثنى التعديل الكامل مره واحده ومعالجه جميع مشاكلك فى حين الذهن حاضر فالموضوع ولا يحتاج لاعاده دراسه الاكواد وتتبعها ومعالجتها

قصر الطريق ع نفسك وع اخوانك حتى يتثنى لهم مساعدتك

تمنياتى لكم بالتوفيق

[طاهر اوفيسنا]

31 دقائق مضت, أبوبسمله said:

قصر الطريق ع نفسك وع اخوانك حتى يتثنى لهم مساعدتك

شكرا استاذ على النصيحة المطلوب تم بواسطة الاستاذ Barna وهو مشكور على ايجاد الحل ولكن الان المشكلة بسيطة وهي في ظهور المبلغ بالميساجmsgBox عند توزيع الاقتطاعات يظهر المبلغ غالط

تقريبا وجدت الحل ويكمن في طريقة وضع في مكانها الصحيح

  rst.Update

 

تم تعديل الخميس at 20:35 بواسطه طاهر اوفيسنا