طاهر اوفيسنا

استاذ ابواحمد حياك وتقبل الله صيامك وقيامك عند تعديلك على الدالة وكانت المطلوب ولكن ضاعت الشروط من الجهة الثانية التي قام التعديل عليها الاستاذ 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)

شكرا استاذ وهو كذلك

وهو كذلك استاذنا الجليل أبو خليل ياريت النظر في الطلب الثاني

للرفع اساتذة هل من حل

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

بوركت استاذ 🌹 من اجتهد واصاب فله أجران ومن اجتهد ولم يصب فله أجر واحد؟

نفس المشكلة لم يتغير شيئا

شكرا استاذ المطلب الثاني ركز في الصور

الاستاذة الأعزاء ابوبسملة وBarnaوغيرهم حياكم الله اليوم تمت انخراط العامل رقم ،261 مبلغ مالي قدره 3000.00 ولكن عندما نقوم بفتح FrmTransfer يقوم الكود بإقتطاع له مبلغ إضافي 1500.00 ليصبح 4500.00 وهذا خطأ اي الكود مزال يعاني من المشاكل حاولت التعديل على دالة Between في الكود واستبدلت شرط DateSerial 2,،28 استبدلتها ب 3,31 فامتنع الكود على الاقتطاع الاضافي ولكن مزلت متخوف يمكن تكون مشاكل في جويلية القادم وبارك الله فيكم. مشكلة 2025.rar

السلام عليكم اساتذة وقع لدي مشكلة وهو 1/عند تحويل مبلغ مالي كما في الصورة ينعكس التاريخ مثلا 2025/03/10 تصبح 2025/10/03 (الوحدة النمطية Verccp)مما تسبب لي مشكلة في فتح فورم Frm_VermLoans عند الضغط مرتين عند مبلغ TheValueCCP لايفتح. . . 2/ عند فتح الفورم الاخير ياحبذا تكون التصفية باالاسفل حسب المبالغ (مبلغ القروض لوحدها ومبلغ الانخراطات لوحدها) تحويل مبلغ.mdb.zip

شكرا اساتذتي الكرام على مد يد المساعدة وتقبل الله صيامكم وقيامكم فيه سؤال : لماذا عند فتح الفورم FrmTransfer يكون تنفيذ الكود ثقيل جدا ؟ اي الفورم يقتخ بعد مدة زمنية طويلة مالسبب ؟

اخي حسب الجدول فإن السجلات التي أشرت لها لا علاقة لها بالدفع خلال السنوات المعنية 2024-2025 ملاحظة : في نظري فيه نقص في ملء سجل البيانات

لاحظ الصورة نتمنى يكون المطلوب test6325.rar

عفوا على المداخلة اساتذة في الورد كنت نقوم بطباعة ورق حجم A3 بحجم A4 دون إعادة تنسيق وتظبيط تنسيق التقرير وتصغير الحقول والخطوط لتلائم حجم ال A4 كما اشار إليها الاستاذ Moosak بخاصية في الطابعة ونفس الشيء تطبق على الاكسس

شكرا استاذ على التكملة

استاذ تقريبا توصلت لحل ولكن بقيت مشكلة كما في الصورة BAR_A(5.3.2025).rar

تفضل استاذي الكريم BAR_A(432025).rar

استاذ فكرت وزدت لكل الجدول سجل وسميته Menha_ID ورقمت المنح العائلية رقم 1 والتعويضات الطبية رقم 2 والعمرة رقم3 وبعدين عملت استعلام توحيد فيه كمايلي Id و Nom_Menhaو Menha_ID فظهرت كل الاسماء و الترقيمات في كومبوبكس والان هل من فكرة لكي يتم التصفية ?

حاليا وحسب البرمجة لايوجد رابط بينهما الا يكون رابط بينهما عن طريق كود مثلا استاذ ام هذا صعب ? لنفرض اننا عملنا الرابط هو id ولكن في نظري لايصح لان كل الجداول تقريبا بها نفس الترقيم و الاسماء متغيرة يعني نجد أخطأ والمتمثلة في التكرار في التنفيذ

السلام عليكم اساتذتي الكرام مبارك علينا وعليكم الشهر الفضيل عند فتح الفورم FrmMenah وعند اختيار Etar تساوي المنح العائلية او التعويضات الطبية او العمرة او غيرهم وعند الضغط على فتح نموذج الشرط يفتح الفورم المعني بالتصفية المطلوب جلب قيم الجداول الموجودة واظهارها حسب التصفية في ComBox : Menha_Name BAR_A(32025).rar

فعلا استاذ كلامك صواب انتهبت لها هالحين ووجدت قيمتها فارغة حقا بعد اضافتة للكود وبعد التجربه هي كانت موجودة سابقا ولكن سقطت بقضل التعديلات rst!Loan_ID = 0 اصبح الكود ينفذ بدون مشاكل شكرا لكم احبتي الكرام كل واحد باسمه الخاص على تعبكم معانا تقبلو تحياتي القلبية

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

لو كانت المشكلة في الاستعلام كما اشرت كانت كل الاشهر بها مشاكل حسب فكري المشكلة في وضع دالة الباقي في مكانها الصحيح والله اعلم Remaining1 = Nz(DSum("[Remaining]", "[qry_rptD1]"), 0) لان بدون مبلغ الباقي Remaining1 يظهر الميساج عادي ولكن فارغ انظر الصورة

جربت استاذ يبدو ان شهر فيفري عادي اما شهر مارس 2025 مزال الكود به مشكلة ادخل على شهر مارس من خلال تغيير التاريخ بالجهاز وليس الفورم وسترى المشكلة BAR_27022025.rar

لاحظ استاذ الصورتين والكود بالمرفق barna.rar