طاهر اوفيسنا

شكرا استاذ AbuuAhmed ربي يشفيك ويعافيك

مبدئيا حسب مارأيت هذا هو المطلوب شكرا لك استاذ ابو أحمد نتمنى لك الشفاء العاجل وربي يسعدك وياريت بعد الشفاء توضح لي أين تم التعديل وشكرا

شكرا استاد ابو أحمد على الاهتمام هذه قيمتها تؤخذ من tbl_loans totalPaid = Nz(DSum("Payment_Made", "tbl_Loans", "EmployeeID = " & ID & " AND Year(Auto_Date) = " & yearNow & " AND Loan_ID = 0"), 0)

01- في نظري يتم وضع هذا الكود قبل كود المنحة بدالة IF ولكن المشكلة اين يوضع وكيف يتم التنسيق بينهما ( اي لما ندخل من فورم القروض ينتقل الكود مباشرة الى القروض واذا دخلنا من فورم المنح يذهب مباشرة الى كود المنح) Select Case [Forms]![FrmCridi]![Etar] Case "القروض المالية" CridiID = [Forms]![FrmCridi]![Frm_sub].[Form]![CmdCridi] latestDate = Nz(DMax("Cridi_Date", "[Cridi]", "[EmployeeID] = " & ID & " AND [Cridi_ID] = " & CridiID), #1/1/1900#) Case "الأدوات الكهرومنزلية" ElecID = [Forms]![FrmElec]![Frm_sub].[Form]![CmdElec] latestDate = Nz(DMax("Elec_Date", "[ Elec]", "[EmployeeID] = " & ID & " AND [Elec_ID] = " & ElecID), #1/1/1900#) 02- وضع الاستاذ Barna هذا الشرط في الكود غير مفهوم ' جلب معرف المنحة من النموذج والتحقق من نوع الامتياز menhaID = 0 03 - اساتذتي الي يعرف كيف يتم التعديل رجاءا لايبخل علينا بالحل 04- اي استفسار غير مفهوم فالعبد لله موجود للتوضيح ماهو مطلوب

اساتذتي الكرام الكود يعمل بشكل جيد في فورم المنح واردت زيادة فورم القروض فكيف يتم التعديل وشكرا

السلام عليكم اساتذة تعديلا على الموضوع الرابط هنا المطلوب التعديل على هذا الكود علما انه مخصص للمنح والتعويضات فقط والان اريد زيادة القروض والادوات الكهرومنزلية اي منح الاستفادة منهما يشرط ان يكون منخرطا بدفع مبلغ مالي قيمة 3000 Public Function CheckInkhirat(ByRef ID As Integer) As String On Error GoTo err_CheckInkhirat Dim yearNow As Integer, totalPaid As Currency Dim paymentMarch As Boolean, paymentJuly As Boolean Dim t As Integer, t1 As Integer Dim result_haj As Variant, latestDate As Variant Dim todayDate As Date, yearsDifference As Long Dim menhaID As Integer, eligibilityPeriod As Integer Dim menhaName As String, menhaType As String Dim message As String ' تحديد السنة الحالية If Month(Date) < 3 Then yearNow = Year(Date) - 1 t = 1 Else yearNow = Year(Date) t = 2 End If ' الحصول على تاريخ اليوم todayDate = Date ' إجمالي المبلغ المدفوع totalPaid = Nz(DSum("Payment_Made", "tbl_Loans", "EmployeeID = " & ID & " AND Year(Auto_Date) = " & yearNow & " AND Loan_ID = 0"), 0) ' جلب معرف المنحة من النموذج والتحقق من نوع الامتياز menhaID = 0 Select Case [Forms]![FrmMenah]![Etar] Case "المنح العائلية" menhaID = [Forms]![FrmMenah]![Frm_sub].[Form]![CmdMenha] latestDate = Nz(DMax("Menha_Date", "[Mena7]", "[EmployeeID] = " & ID & " AND [Menha_ID] = " & menhaID), #1/1/1900#) Case "التعويضات الطبية" menhaID = [Forms]![FrmMenah]![Frm_sub].[Form]![cmdSanitaire] latestDate = Nz(DMax("[Sanitaire_Date]", "[Sanitaire]", _ "[EmployeeID] = " & [Forms]![FrmMenah]![EmployeeID] & _ " And [Nom_Beneficiaire] = '" & Replace([Forms]![FrmMenah]![Frm_sub].[Form]![Nom_Beneficiaire], "'", "''") & "'" & _ " And [Sanitaire_ID] = " & [Forms]![FrmMenah]![Frm_sub].[Form]![cmdSanitaire]), #1/1/1900#) End Select ' جلب اسم المنحة ونوعها وفترة الاستحقاق من الجدول menhaName = Nz(DLookup("Menha_Name", "tbl_MenhaRules", "Menha_ID = " & menhaID & " AND Menha_Type = '" & [Forms]![FrmMenah]![Etar] & "'"), "") menhaType = Nz(DLookup("Menha_Type", "tbl_MenhaRules", "Menha_ID = " & menhaID & " AND Menha_Type = '" & [Forms]![FrmMenah]![Etar] & "'"), "") eligibilityPeriod = Nz(DLookup("Eligibility_Period", "tbl_MenhaRules", "Menha_ID = " & menhaID & _ " AND Menha_Type = '" & menhaType & "' AND Eligibility_Period > 0"), 0) ' التحقق إذا كانت هناك فترة استحقاق مسجلة If eligibilityPeriod > 0 Then yearsDifference = DateDiff("yyyy", latestDate, todayDate) t1 = IIf(yearsDifference < eligibilityPeriod, 1, 2) End If ' التحقق من دفع المبلغ في مارس ويوليو paymentMarch = Nz(DLookup("Payment_Made", "tbl_Loans", "EmployeeID = " & ID & " AND Year(Auto_Date) = " & yearNow & " AND Month(Auto_Date) = 3"), 0) = 1500 paymentJuly = Nz(DLookup("Payment_Made", "tbl_Loans", "EmployeeID = " & ID & " AND Year(Auto_Date) = " & yearNow & " AND Month(Auto_Date) = 7"), 0) = 1500 ' بناء الرسالة بناءً على الشروط If totalPaid = 3000 Then message = "عزيزي المنخرط(ة)، يمكنك الاستفادة من " & menhaType & ": " & menhaName & "." If t = 1 Then message = message & " لأنك دفعت مبلغ الانخراط الخاص بالسنة الماضية كاملاً." ElseIf t = 2 Then message = message & " لأنك دفعت مبلغ الانخراط كاملاً." If paymentMarch And paymentJuly Then message = message & " على دفعتين." End If End If ' التحقق من آخر تاريخ لاستفادة المنحة If Not IsNull(latestDate) And eligibilityPeriod > 0 Then If eligibilityPeriod = 100 Then ' إذا كانت فترة الاستحقاق 100، تكون المنحة لمرة واحدة فقط message = "عزيزي المنخرط(ة)، لا يمكنك الاستفادة من " & menhaType & ": " & menhaName & "." & vbNewLine & _ "هذه المنحة يتم الاستفادة منها مرة واحدة فقط." ElseIf t1 = 1 Then ' في حالة الرفض بسبب فترة الاستحقاق message = "عزيزي المنخرط(ة)، لا يمكنك الاستفادة من " & menhaType & ": " & menhaName & "." & vbNewLine & _ "لقد استفدت من هذه المنحة بتاريخ: " & Format(latestDate, "dd/mm/yyyy") & "." & vbNewLine & _ "يجب الانتظار لمدة " & eligibilityPeriod & " سنة قبل الاستفادة مجددًا." Else ' في حالة القبول بعد انتهاء فترة الاستحقاق message = message & vbNewLine & "يمكنك الاستفادة من المنحة مجددًا." End If End If Else ' في حالة عدم دفع مبلغ الانخراط message = "عزيزي المنخرط(ة)، لا يمكنك الاستفادة من " & menhaType & ": " & menhaName & "." & vbNewLine & _ "لم تقم بدفع مبلغ الانخراط بالكامل المطلوب للاستفادة." End If ' إرجاع الرسالة CheckInkhirat = message Exit Function err_CheckInkhirat: MsgBox "خطأ رقم " & Err.Number & ": " & Err.Description, vbCritical, "خطأ" CheckInkhirat = "حدث خطأ أثناء التحقق من بيانات الانخراط." End Function BAR_A(2025).rar

هل من مساعدة اساتذة استاذ Barna يبدو أنه غايب عن المنتدى نتمنى ان يكون بخير

السلام عليكم استاذ Barna معذرة . . . استاذي تم التعديل على المنح ونسيت القروص المالية والأدوات الكهرومنزلية قكيف يتم إضافة الكود الخاص بهم Select Case [Forms]![FrmCridi]![Etar] Case "القروض المالية" CridiID = [Forms]![FrmCridi]![Frm_sub].[Form]![CmdCridi] latestDate = Nz(DMax("Cridi_Date", "[Cridi]", "[EmployeeID] = " & ID & " AND [Cridi_ID] = " & CridiID), #1/1/1900#) Case "الأدوات الكهرومنزلية" ElecID = [Forms]![FrmElec]![Frm_sub].[Form]![CmdElec] latestDate = Nz(DMax("Elec_Date", "[Cridi]", "[EmployeeID] = " & ID & " AND [Elec_ID] = " & ElecID), #1/1/1900#) End Select الى الكود التالي المعدل من حضربك Public Function CheckInkhirat(ByRef ID As Integer) As String On Error GoTo err_CheckInkhirat Dim yearNow As Integer, totalPaid As Currency Dim paymentMarch As Boolean, paymentJuly As Boolean Dim t As Integer, t1 As Integer Dim result_haj As Variant, latestDate As Variant Dim todayDate As Date, yearsDifference As Long Dim menhaID As Integer, eligibilityPeriod As Integer Dim menhaName As String, menhaType As String Dim message As String ' تحديد السنة الحالية If Month(Date) < 3 Then yearNow = Year(Date) - 1 t = 1 Else yearNow = Year(Date) t = 2 End If ' الحصول على تاريخ اليوم todayDate = Date ' إجمالي المبلغ المدفوع totalPaid = Nz(DSum("Payment_Made", "tbl_Loans", "EmployeeID = " & ID & " AND Year(Auto_Date) = " & yearNow & " AND Loan_ID = 0"), 0) ' جلب معرف المنحة من النموذج والتحقق من نوع الامتياز menhaID = 0 Select Case [Forms]![FrmMenah]![Etar] Case "المنح العائلية" menhaID = [Forms]![FrmMenah]![Frm_sub].[Form]![CmdMenha] latestDate = Nz(DMax("Menha_Date", "[Mena7]", "[EmployeeID] = " & ID & " AND [Menha_ID] = " & menhaID), #1/1/1900#) Case "التعويضات الطبية" menhaID = [Forms]![FrmMenah]![Frm_sub].[Form]![cmdSanitaire] latestDate = Nz(DMax("[Sanitaire_Date]", "[Sanitaire]", _ "[EmployeeID] = " & [Forms]![FrmMenah]![EmployeeID] & _ " And [Nom_Beneficiaire] = '" & Replace([Forms]![FrmMenah]![Frm_sub].[Form]![Nom_Beneficiaire], "'", "''") & "'" & _ " And [Sanitaire_ID] = " & [Forms]![FrmMenah]![Frm_sub].[Form]![cmdSanitaire]), #1/1/1900#) End Select ' جلب اسم المنحة ونوعها وفترة الاستحقاق من الجدول menhaName = Nz(DLookup("Menha_Name", "tbl_MenhaRules", "Menha_ID = " & menhaID & " AND Menha_Type = '" & [Forms]![FrmMenah]![Etar] & "'"), "") menhaType = Nz(DLookup("Menha_Type", "tbl_MenhaRules", "Menha_ID = " & menhaID & " AND Menha_Type = '" & [Forms]![FrmMenah]![Etar] & "'"), "") eligibilityPeriod = Nz(DLookup("Eligibility_Period", "tbl_MenhaRules", "Menha_ID = " & menhaID & _ " AND Menha_Type = '" & menhaType & "' AND Eligibility_Period > 0"), 0) ' التحقق إذا كانت هناك فترة استحقاق مسجلة If eligibilityPeriod > 0 Then yearsDifference = DateDiff("yyyy", latestDate, todayDate) t1 = IIf(yearsDifference < eligibilityPeriod, 1, 2) End If ' التحقق من دفع المبلغ في مارس ويوليو paymentMarch = Nz(DLookup("Payment_Made", "tbl_Loans", "EmployeeID = " & ID & " AND Year(Auto_Date) = " & yearNow & " AND Month(Auto_Date) = 3"), 0) = 1500 paymentJuly = Nz(DLookup("Payment_Made", "tbl_Loans", "EmployeeID = " & ID & " AND Year(Auto_Date) = " & yearNow & " AND Month(Auto_Date) = 7"), 0) = 1500 ' بناء الرسالة بناءً على الشروط If totalPaid = 3000 Then message = "عزيزي المنخرط(ة)، يمكنك الاستفادة من " & menhaType & ": " & menhaName & "." If t = 1 Then message = message & " لأنك دفعت مبلغ الانخراط الخاص بالسنة الماضية كاملاً." ElseIf t = 2 Then message = message & " لأنك دفعت مبلغ الانخراط كاملاً." If paymentMarch And paymentJuly Then message = message & " على دفعتين." End If End If ' التحقق من آخر تاريخ لاستفادة المنحة If Not IsNull(latestDate) And eligibilityPeriod > 0 Then If eligibilityPeriod = 100 Then ' إذا كانت فترة الاستحقاق 100، تكون المنحة لمرة واحدة فقط message = "عزيزي المنخرط(ة)، لا يمكنك الاستفادة من " & menhaType & ": " & menhaName & "." & vbNewLine & _ "هذه المنحة يتم الاستفادة منها مرة واحدة فقط." ElseIf t1 = 1 Then ' في حالة الرفض بسبب فترة الاستحقاق message = "عزيزي المنخرط(ة)، لا يمكنك الاستفادة من " & menhaType & ": " & menhaName & "." & vbNewLine & _ "لقد استفدت من هذه المنحة بتاريخ: " & Format(latestDate, "dd/mm/yyyy") & "." & vbNewLine & _ "يجب الانتظار لمدة " & eligibilityPeriod & " سنة قبل الاستفادة مجددًا." Else ' في حالة القبول بعد انتهاء فترة الاستحقاق message = message & vbNewLine & "يمكنك الاستفادة من المنحة مجددًا." End If End If Else ' في حالة عدم دفع مبلغ الانخراط message = "عزيزي المنخرط(ة)، لا يمكنك الاستفادة من " & menhaType & ": " & menhaName & "." & vbNewLine & _ "لم تقم بدفع مبلغ الانخراط بالكامل المطلوب للاستفادة." End If ' إرجاع الرسالة CheckInkhirat = message Exit Function err_CheckInkhirat: MsgBox "خطأ رقم " & Err.Number & ": " & Err.Description, vbCritical, "خطأ" CheckInkhirat = "حدث خطأ أثناء التحقق من بيانات الانخراط." End Function علمان انه فورم مستقل لوحده ومافيه حتى شرط الا ان يكون دافع مبلغ الانخراط كما في المنح والتعويضات BAR_A(2025).rar

اوك فهمت الان استاذ كانت فكرتي سابقا خاطئة

ان شاء الله هذا مثال بسيط للتعلم ارني كيف استنتج هذا المبلغ 650000 من الجدول tbl_Loans بالتفصيل للعلم انا اعرف ماذا يمثل هذا المبلغ ولكن اردت طريقة الحساب التي يوضحها Debug.Print وشكرا 20252025.rar

يمكن ولكن كنت فاكر أنه يجلب لك كل المجاميع التي خصصتها في الكود او القيم ذات النتيجة المحصلة مثلا باقي في عملية ما قيمة 65000.00 يعني يوصلك هذا المبلغ كيف استنتج ومن اين استخرج اليس كذلك .

اهلا استاذ كيف لي ان اتفحص النتيجة بالتدقيق من الجدول لكي ارى أين الخلل لانها أرتني المبلغ بدون تفصيل

فعلا استاذ تعديلك صحيح 100% وكان الرد منذ 6 ساعات تقريبا ولكن استاذي العزيز أعذرني والله ما انتبهت للحل من كثرة تهاطل الردود مساء اليوم كنت افتكر انني راسلتك على خطأ بأحد الاكواد اسف 1000 مرة استاذي العزيز ربنا مايحرمنا من تواجدك معنا ومساعدة اخوانك المبتديين جعلك الله ذخرا لهذا المنتدى الغالي ومنيرا له بوركت تقبل تحياتي القلبية الخالصة

نعم وجدت الحل من مشاركة الاستاذ Eng.Qassim تفضل استاذي العزيز 20260101.rar

من جدول Tbl_loans

نعم جربت وظهرت النتيجة تمام استاذ

فعلا استاذي العزيز كلامك صواب ولكن المشكلة كسرت بحيلة ذكية من طرف الاستاذ Eng.Qassim

فعلا لازم تعمل حيلة باش تكسر مشكلة الاكسس ههههههه تمت الحيلة هههههههههه في If Me.T9E = 0 Then Lblt9e = 0 Else Me.Lblt9e = rst.RecordCount End If rst.Close Set rst = Nothing الله يعطيك العافية استاذ بارك الله فيك ولقد استفدت من الحيلة حتى في Lblt9

في طريقك الي الحل الصحيح استاذ ولكن بقيت

انظر الصور سنة 2024 سنة 2025

202511.rar

*- هذه الجملة اعطت نتيجة في سنة 2025 فقط الديون المتبقية الى غاية : 2024/12/31 1.349.000.00 83 اما في سنة 2024 فأعطت نتيجة خاطئة الديون المتبقية الى غاية : 2023/12/31 0.00 74 *- اما الاول ولاخير فلم يعطيا النتيجة الصحيحة الاول مزال به خطأ والاخير لم يعطي الحل الصحيح الديون المتبقية الى غاية : 2023/12/31 0.00 734 الديون المتبقية الى غاية : 2024/12/31 1.349.000.00 612

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

الملف مرفقا من ثالث رد 2025-01-01_06-47-01.rar

لا لم تغير شيئا الصورة توضح الحل الصحيح