طاهر اوفيسنا

تقبل الله منا ومنكم سائر الاعمال وكل عام وانتم بالف خير لم إفهم اي تنسيق تقصد وثاني كلمة wada3 = "تم التأجيل" لم اراها في الكود المهم بعد التجربة الاشهر الاقتطاع المعفاة لم يتغير المبلغ الى 0 ومع الوضعية السداد لم تكتب " تم التأجيل"

استاذ ممكن اعرف أين تم التعديل من حضرتك لان حسب الصورة الي ارسلتها مؤخرا هو المطلوب ولكن المرفق مابه اي تغيير

تقبل الله منا الصيام والقيام وكل عام والامة الاسلامية بالف خير

اي صورة صورتك التي ارفقتها ام صورتي

العمل الصحيح كما في الصورة علما ان اشهر التاجيل شهر 5 و 6

استاذي لقد غيرت كلمة And ب Or واصبح الكود يدخل للجميع اي يوافق على منح المنح للكل حتى اذا ظهر لك الميساج لايمكنك الاستفادة يخرج بعدها ميساج هل تريد تثبيت المنحة

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

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

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

شكرا استاذ على الرد من قبل كان الكود يضيف السجلات المؤجلة ليست المشكلة هنا انظر لما نسخت الكود ونفذته "تاجيل لمدة 02 اشهر ابتداء من تاريخ : 2025/04/01 " ايش سوى حسب الصورة

ان شاء الله استاذ

شكرا استاذي العزيز ربي يبارك فيك الكود يزيد عادي عذذ السجلات التي تعطيها له ولكن المشكلة عندما يزيد عدد السجلات يزيد المبلغ وهذا هو الخطا يلزم الاشهر المعفاه تبحول مبالغها الى 0 ويكتب عند السداد تم تأجيل وتعوض مبلغها عند السجلات الجديدة والصورة هي المطلوب

السلام عليكم اساتذتي بالمرفق يا حبذا التعديل على كود اعادة ترتيب الاقتطاع (تاجيل الاقتطاع لمدة زمنية معينة) اولا الدخول على فورم FrmCridi نلاخظ العامل كريمو4 لديه قرض بقيمة 50.000.00 دج بداية الاقتطاع : 2025/03/01 نهاية الاقتطاع : 2025/12/01 وتم اقتطاع شهرين مارس وافريل 2025 مثلا وطلب مني تاجيل الاقتطاع لمدة 02 اشهر ابتداء من تاريخ : 2025/05/01 (زر اعادة ترتيب الاقتطاع) المطلوب اضافة تعديلات على الكود ليصبح عند الشهرين المؤجلين 2025/05/01 قيمة الاقتطاع كانت 5000.00 قبل التأجيل وتصبح 0.00 بعد التأجيل ويكتب في وضعية التسديد "تم التأجيل" 2025/06/01 قيمة الاقتطاع كانت 5000.00 قبل التأجيل وتصبح 0.00 بعد التأجيل ويكتب في وضعية التسديد "تم التأجيل" والصورة توضح مع العلم ان الكود حاليا يشتغل كما في الصورة تأجيل الاقتطاع.rar

اساتذتي الكرام حاولت اعمل تعديلات في Msg وفلحت فيها الا ان النهاية مؤسفة الميساج يقول يمكنك الاستفادة وفي الاخير الكود يرفض هل من تعديل على القاعدة وشكرا Taher_20250325.rar

وهذا لم تجيني عليه ام فيه عمل شاق استاذي العزيز

شكرا استاذ على التعديل الصحيح الان استاذي العزيز القيم المالية 3000 و 1500 قهي ربما تكون غير ثابتة مستقبلا فكيف يتم جلبها من الجدول بدلا من كتابتها في MsgBox تقليدي message = "عزيزي المنخرط(ة)، يمكنك الاستفادة من " & menhaType & ": " & menhaName & Etar & " حتى تاريخ 30/06 للعام الحالي لأنك سددت 3000 للعام السابق و1500 لشهر مارس للعام الحالي." صح لسانك استاذي الاكسوارات على صاحب البرنامج فعلا ولكن ياريت تجربة لهذه الدالة vbMsgBoxRight على الاقل حتى لميساج واحد وا لباقي اكمله بنفسي وشكرا لكم

شكرا استاذتي على الرد ولكن عند ظهور هذا الميساج ومن خلالة يقول أنه لايمكن الاستفادة بعد تاريخ جويلية لاحظ عند الضغط على زر موافق سيخرج لك ميساج هل تريد تثبيت تاريخ المنحة وهنا النقص في الكود واذا تم التعديل فياريت ارفاق القاعدة المعدل عليها للتجربة اما رد الاستاذ Foksh بحصوص ضمان عرض الرسالة بشكل منطقي وسهل القراءة ، اعتقد اضافة الجزء vbMsgBoxRight لتحويل نص الرسالة من اليمين الى اليسار كقراءة لللغة العربية سيكون أفضل أيضاً فياريت مبادرة منك استاذ لانه في الحقيقة صعب تحويل النص بالعربية بالموديل وشكرا لكم

وياريت كتابة شهر مارس او جويلية في MsgBox تكون مصدرها الجدول tbl،_loans و بالاخص حقل Month(Paiment_Month)لانه فيه تاريخ بداية دفع الانخراط

شكرا استاذ على الاهتمام والتعديل استاذ انت عدلت على msgBox فقط ولم تتطرق الى تنفيذ الكود بموافقة منح " المنحة او رفضها" حسب الشروط لاحظ الصورة كعينة MsgBox يقول احقية الاستفادة الى غاية 2025/06/30 اي بعد هذا التاريخ لايحق له وانظر تاريخ الجهاز 2025/07/23 ونلاحظ الكود ينفذ اعطاء المنحة "فما تناقض" وكأن شيء لم يكن اتمنى انك فهمت النقائص وشكرا

شكرا استاذي العزيز على التعديل وحمد لله على سلامتك والله وحشتنا جربت الكود بعد مارس 2025 وبعد جويلية 2025 حسب التعديل الصحيح غير في كريمو1 و كريمو 2 والاخطاء في : كريمو3 لايستفيد عند دخول شهر جويلية وبعده كريمو4 لايستفيد عند دخول شهر مارس وبعده كريمو5 لايستفيد عند دخول شهر جويلية وبعده كريمو6 يكون مثل كريمو2 ولكن الميساج يتغير بشهر جويلية آمل ان اجد حلا في القريب العاجل

شكر استاذ ناقل على الاهتمام تقبل الله صيامك وقيامك بمزيدا من الاجر والثواب المطلوب في تنسيق ظهور الميساجات طبقا للصورة السفلى BAR_A_20250320.rar

نعم استاذ تمت التجربة بخصوص الاستفادة من جهة القروض لاتوجد مشكلة وكذا من جهة المنح كذلك ولكن مزلت أرى عدم ظهور بعض الميساجات من الثمانية الميساجات بالكود 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 & _ "لم تقم بدفع مبلغ الانخراط بالكامل المطلوب للاستفادة." مانعرف مامحلها من العمل او متى يذهب الكود اليها بالرغم من تجربتي في اكثر الحالات

لقد اكتشفت الخطأ في كلمة Itar و الاصح Etar

مالك استاذ Foksh متعجب !!!!! فعلا وقتها نظرت للتعديل القروض فقط ولم اكن اعلم ان التعديل يعمل مشكلة مع فوم المنح واليوم عند اعطاء المنح وجدت مشكلة في موظف لديه استفادة من نظارات طبية بتاريخ : 2023/10/19 وتقدم بطلب ثاني للتعويض بتاريح 2025/03/18 وهو لم يستوفي الـ 2 سنة كاملة فالكود وافق على اعطائه التعويض ومن هنا تفطنت بان الكود لا يشتغل بصحيح

استاذ ابواحمد حياك وتقبل الله صيامك وقيامك عند تعديلك على الدالة وكانت المطلوب ولكن ضاعت الشروط من الجهة الثانية التي قام التعديل عليها الاستاذ Barna اي وقعت مشكلة عند الشروط في فورم FrmMenah وعند الغاء التعديل الذي تم من حضرتك تنفذ الدالة الشرط بشكل عادي فياريت اعادة النظر في تعديل الكود الكود الصحيح من غير (FrmCridi ) المعدل من طرف الاستاذ Barna هو 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) yearsDifference = Int(DateDiff("d", [latestDate], todayDate) / 365.25) 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 واستدعائها result = CheckInkhirat(emp) الكود المعدل (به مشكلة شرط النظارات الطبية ) من طرف الاستاذ ابو احمد هو Public Function CheckInkhirat(ByRef ID As Integer, Optional FrmName As String = "FrmMenah") 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 Dim Etar As String Dim Frm As Form Set Frm = Forms(FrmName) Etar = Frm.Etar ' تحديد السنة الحالية 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 Itar Case "المنح العائلية" menhaID = Frm.Frm_sub.Form.CmdMenha latestDate = Nz(DMax("Menha_Date", "[Mena7]", "[EmployeeID] = " & ID & " AND [Menha_ID] = " & menhaID), #1/1/1900#) Case "التعويضات الطبية" menhaID = Frm.Frm_sub.Form.cmdSanitaire latestDate = Nz(DMax("[Sanitaire_Date]", "[Sanitaire]", _ "[EmployeeID] = " & Frm.EmployeeID & _ " And [Nom_Beneficiaire] = '" & Replace(Frm.Frm_sub.Form.Nom_Beneficiaire, "'", "''") & "'" & _ " And [Sanitaire_ID] = " & Frm.Frm_sub.Form.cmdSanitaire), #1/1/1900#) End Select ' جلب اسم المنحة ونوعها وفترة الاستحقاق من الجدول menhaName = Nz(DLookup("Menha_Name", "tbl_MenhaRules", "Menha_ID = " & menhaID & " AND Menha_Type = '" & Etar & "'"), "") menhaType = Nz(DLookup("Menha_Type", "tbl_MenhaRules", "Menha_ID = " & menhaID & " AND Menha_Type = '" & 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) yearsDifference = Int(DateDiff("d", [latestDate], todayDate) / 365.25) 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 Set Frm = Nothing Exit Function err_CheckInkhirat: MsgBox "خطأ رقم " & Err.Number & ": " & Err.Description, vbCritical, "خطأ" CheckInkhirat = "حدث خطأ أثناء التحقق من بيانات الانخراط." End Function واستدعائها result = CheckInkhirat(emp, Me.Parent.NAME)