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

[أبوبسمله]

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

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

Expand  

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

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

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

  في 18‏/2‏/2025 at 11:22, أبوبسمله said:

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

Expand  

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

[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.zipFetching info...

تم تعديل فبراير 18 بواسطه Foksh
إضافة ملف نصي للكود ، بناءً على طلب صاحب الموضوع

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

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

[Foksh]

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

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

Expand  

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

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

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

[Barna]

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

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

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

Expand  

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

 

BAR_1.mdbFetching info...

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

[Foksh]

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

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

Expand  

حسناً ، جرب هذا التعديل ، حيث استخدمنا 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

 

 

 

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

  في 18‏/2‏/2025 at 12:38, Barna said:

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

 

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

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

Expand  

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

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

  في 18‏/2‏/2025 at 12:38, Barna said:

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

 

Expand  

استاذ لماذا وظفت زوج 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 19:27, طاهر اوفيسنا said:

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

Expand  

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

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

  في 18‏/2‏/2025 at 20:15, Barna said:

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

Expand  

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

تم تعديل فبراير 18 بواسطه طاهر اوفيسنا

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

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

[Barna]

  في 19‏/2‏/2025 at 08:15, طاهر اوفيسنا said:

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

Expand  

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

 

BAR_2.mdbFetching info...

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

  في 19‏/2‏/2025 at 14:22, Barna said:

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

Expand  

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

تم تعديل فبراير 19 بواسطه طاهر اوفيسنا

[أبوبسمله]

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

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

Expand  

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

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

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

Expand  

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

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

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

Expand  

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

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

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

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

  في 20‏/2‏/2025 at 20:03, أبوبسمله said:

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

Expand  

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

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

  rst.Update

 

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

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

بعد التعديلات وعند تنفيذ الكود اكتشفت ان الكود لايذهب الى الجزء الثاني ( الشرط) والذي به الميساج  MsgBox الذي يبين مبلغ الاقتطاع ويذهب الا في شهري اقتطاع الانخراط فقط يعني (شهر3و 7) اما الإشهر الباقية لايذهب  أين تكمن المشكلة ؟ياترى

[ناقل]

  في 17‏/2‏/2025 at 20:52, Barna said:

If Month(Now()) = 3 Or Month(Now()) = 7 Then

Expand  

راجع قاعدة IF في الكود لأنها محددة بشرط أن يكون تاريخ الان أما شهر 3 أو 7

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

  في 23‏/2‏/2025 at 11:58, ناقل said:

راجع قاعدة IF في الكود لأنها محددة بشرط أن يكون تاريخ الان أما شهر 3 أو 7

Expand  

شكرا استاذ ولكن قبل التعديل الاخير كان الكود يدخل عادي في كل الإشهر ويظهر ميساج المبلغ ومن خلال المقارنة بين القديم و الجديد حسب علمي اتضح لي ان الفرق في كلمة loop  وقديما كانت  Next i  والله اعلم

Loop.Next i.rarFetching info...

[Barna]

  في 23‏/2‏/2025 at 14:25, طاهر اوفيسنا said:

شكرا استاذ ولكن قبل التعديل الاخير كان الكود يدخل عادي في كل الإشهر ويظهر ميساج المبلغ ومن خلال المقارنة بين القديم و الجديد حسب علمي اتضح لي ان الفرق في كلمة loop  وقديما كانت  Next i  والله اعلم

Expand  

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

اخي الكريم @طاهر اوفيسنا 

اسف اولا لعدم دخولي المنتدى لانشغالي في تصميم برنامج لأحد الأشخاص

ثانيا ممكن توضيح ماذا تريد أو ما هي المشكلة التي في الكود 

هل تريد ان يعمل الكود في كل مرة يتم فيها فتح النموذج أم فقط في شهري 3 و 7 فقط

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

  في 26‏/2‏/2025 at 19:30, Barna said:

ثانيا ممكن توضيح ماذا تريد أو ما هي المشكلة التي في الكود 

هل تريد ان يعمل الكود في كل مرة يتم فيها فتح النموذج أم فقط في شهري 3 و 7 فقط

Expand  

شكرا استاذي العزيز وربي يوفقك مشكلتي وهي عند التعديل على الكود يظهر ميساج مبلغ الاقتطاعات إلا في شهر 3و7 و المطلوب ظهوره عند كل شهر اقتطاع لكي نعرف قيمة المبلغ المقتطع

[Barna]

  في 26‏/2‏/2025 at 20:04, طاهر اوفيسنا said:

مشكلتي وهي عند التعديل على الكود يظهر ميساج مبلغ الاقتطاعات إلا في شهر 3و7 و المطلوب ظهوره عند كل شهر اقتطاع لكي نعرف قيمة المبلغ المقتطع

Expand  

طيب جرب المرفق التالي بعد مسح الاقتطاعات
 

BAR_2.mdbFetching info...

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

  في 26‏/2‏/2025 at 20:52, Barna said:

طيب جرب المرفق التالي بعد مسح الاقتطاعات

Expand  

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

 

[Barna]

  في 26‏/2‏/2025 at 21:35, طاهر اوفيسنا said:

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

Expand  

هذا طبيعي لانه تم الاقتطاع صحيح

راجع الجدول هل تم الاقتطاع لهذه الاشهر