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

[Barna]

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

[Barna]

قد يكون هذا الفانك أقل عدد اسطر من السابق جربة واعلمنا بالنتيجة ...................

Public Function CheckInkhirat(ByRef ID As Integer) As String
    On Error GoTo err_CheckInkhirat

    Dim yearNow As Integer, totalPaid As Currency, totalPaidLastYear 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

    ' تحديد السنة
    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)

    ' تحقق من نوع الامتياز
    Select Case [Forms]![FrmMenah]![Etar]
        Case "المنح العائلية"
            result_haj = DLookup("[Menha_Date]", "[Mena7]", "[EmployeeID] =" & ID & " And [Menha_ID] =" & [Forms]![FrmMenah]![Frm_sub].[Form]![CmdMenha] & " And [Menha_ID] =11")
        Case "التعويضات الطبية"
        result_haj = Null
            If [Forms]![FrmMenah]![Frm_sub].[Form]![cmdSanitaire] = 2 Then
                latestDate = Nz(DMax("[Sanitaire_Date]", "[Sanitaire]", "[EmployeeID] =" & [Forms]![FrmMenah]![EmployeeID] & " And [Nom_Beneficiaire] ='" & [Forms]![FrmMenah]![Frm_sub].[Form]![Nom_Beneficiaire] & "'"), #10/1/2000#)
                yearsDifference = DateDiff("yyyy", latestDate, todayDate)
                t1 = IIf(yearsDifference < 2, 1, 2)
            End If
    End Select

    ' التحقق من دفع المبلغ في مارس ويوليو
    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
        Dim message As String
        message = "عزيزي المنخرط(ة)، يمكنك الاستفادة من "

        If t = 1 Then
            message = message & "الامتيازات لأنك دفعت مبلغ الانخراط الخاص بالسنة الماضية كاملاً."
        ElseIf t = 2 Then
            message = message & "جميع الامتيازات لأنك دفعت مبلغ الانخراط كاملاً"
            If paymentMarch And paymentJuly Then
                message = message & " على دفعتين."
            Else
                message = message & "."
            End If
        End If

        If Not IsNull(result_haj) Then
            message = message & vbNewLine & "ولكن قد استفت من منحة الحج لعام " & vbNewLine & result_haj
        ElseIf IsNull(result_haj) And t1 = 1 Then
            message = message & vbNewLine & "ولكن قد استفت من منحة النظارات الطبية بتاريخ " & vbNewLine & latestDate
        End If

        CheckInkhirat = message
    Else
        CheckInkhirat = "عزيزي المنخرط(ة)، لا يمكنك الاستفادة من الامتيازات لأنك لم تدفع مبلغ الانخراط."
    End If

    Exit Function

err_CheckInkhirat:
    MsgBox "خطأ رقم " & Err.Number & ": " & Err.Description, vbCritical, "خطأ"
    CheckInkhirat = "حدث خطأ أثناء التحقق من بيانات الانخراط."
End Function

 

[كريمو2]

تمام استاذ الكود يعمل بشكل جيد في كلتى الحالتين

منحة الحج - تعويض النظارات الطبية

والفلترة متوقفة على  "نوعية القرابة" عمل جيد استاذي

ربي يحفظك

 

[كريمو2]

استاذ Barna لنفرض اننا  اشترطنا مستقبلا منحة الزواج [Menha_ID] =5 مرة واحدة فقط

فكيف يكون التعديل على الكود

result_Zawaj = DLookup("[Menha_Date]", "[Mena7]", "[EmployeeID] =" & ID & " And [Menha_ID] =" & [Forms]![FrmMenah]![Frm_sub].[Form]![CmdMenha] & " And [Menha_ID] =5")

 

[Barna]

في 15‏/12‏/2024 at 23:11, كريمو2 said:

استاذ Barna لنفرض اننا  اشترطنا مستقبلا منحة الزواج [Menha_ID] =5 مرة واحدة فقط

فكيف يكون التعديل على الكود

حياك الله .....

بسبب التصميم لديك كل نوع منحة في جدول ( المفترض تون بيانات استحقاق المنح كلها في جدول واحد بدل تعدد الجداول ) وبسبب ان برنامجك اعتقد مصمم وتعمل عليه حاليا .... اقترح عليك او فكرت بانشاء جدول صغير تحسبا للتعديلات مثل ممكن في يوم من الايام تريد نعديل منحة معينة بحيث تصبح النظارات الطبية كل سنه مثلا او يصبح الحج كل 10 سنوات او حتى تضيف منح اخرى للشرط ....
اقتراحي عمل جدول صغير ونسجل فيه كل المنح المشروطة .... مثلا انظر الصورة ...... 100 تعني مره واحدة في العمر

 

 

[كريمو2]

فكرة جيدة استاذ لقد انشأت حقل عدد الاستفادة Beriod في كلى الجدولين    N_Sanitaire وN_Menha وبه ارقام -1مرة واحدة      -100اكثر من مرة.              فكيف يكون التعديل

تم تعديل ديسمبر 17, 2024 بواسطه كريمو2

[Barna]

فكرتي كانت جدول واحد يضاف مثل الصورة ونسجل فيه ما نريد عشان لا نكرر الاكواد لكل جدل ... انظر الصورة

لو كانت المنح كلها في جدول واحد كان افضل ... لان برنامجك في كثرة جداول

[كريمو2]

انظر استاذ مثل هذا كما في الصورة

[Barna]

47 دقائق مضت, كريمو2 said:

انظر استاذ مثل هذا كما في الصورة

هل انت بصدد تعديل شامل على البرنامج ام ماذا؟؟

لاننا لا نريد تعديل الاكواد لكثرتها

فقط نريد انشاء جدول واحد جديد فقط

اقوم لإنشاء الجدول واعدل في المرفق السابق .... انتظرني

تم تعديل ديسمبر 17, 2024 بواسطه Barna

[كريمو2]

منتظرك ان شا ء الله استاذ

[Barna]

2 ساعات مضت, كريمو2 said:

منتظرك ان شا ء الله استاذ

طيب لاحظ الشرح التالي :::::::::::::::::::::::::::::

اولا:: الجدول tbl_MenhaRules يجب كتابة اسم المنحة ورقم المنحة ونوع المنحة كما هو موجود بالجداول الموجودة لديك دون تغيير ( اوكد دون تغير لا في الرقم ولا في الاسم ولا في نوع المنحة) كما في الصورة

ثانيا:::: المنح التي يكتب في هذا الجدول فقط التى عليها شروط ( 1 تعني سنه - 2 تعني سنتان وهكذا - اما التي تصرف مرة واحدة فسجلها 100 )

ثالثا::: بقية المنح لا تسجل ابدا في هذا الجدول ( يعني في النهاية سوف يون لديك عدد سجلات بسيطة في هذا الجدول الجديد tbl_MenhaRules )

رابعا :::: طبق على المثال المرفق واعلمنا بالنتيجة

 

BAR_A.mdb

[كريمو2]

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

ثالثا::: بقية المنح لا تسجل ابدا في هذا الجدول ( يعني في النهاية سوف يون لديك عدد سجلات بسيطة في هذا الجدول الجديد tbl_MenhaRules )

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

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

 اين بقية المنح الاخرى وهل يتم ادراجها ام لا  

[Barna]

3 دقائق مضت, كريمو2 said:

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

هذا الجدول فقط للمنحة المحددة بفترات

يعني مثلا كل سنة ... كل سنتين ... مرة واحدة

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

انت كل ماهو عليك إعادة كتابة المنح التى تريد إعطاء محدودية لها في الجدول الجديد فقط

افتح المرفق وتمعن في الجداول القديمة والجدول الجديد لديك ... سوف تفهم ما حدث

تم تعديل ديسمبر 17, 2024 بواسطه Barna

[كريمو2]

شكرا استاذ على الطرح فكرة ممتازة جدا 

ولكن فما مشكلة في الكود عند انقضاء مدة عامين ومن حقة الاستفادة مجددا

 

 

 

200.rar

[Barna]

6 دقائق مضت, كريمو2 said:

ولكن فما مشكلة في الكود عند انقضاء مدة عامين ومن حقة الاستفادة مجددا

لم افهم عليك ... لاني اخاطبك بالهاتف

[كريمو2]

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

لم افهم عليك ... لاني اخاطبك بالهاتف

انظر استاذ

كريمو1 استفاد في سنة  2021 بنظارات طبية 

في سنة 2024 من حقة الاستفادة مجددا ....... صح

ولكن يظهر

اولا يوافقك الاستفادة 

ثانيا يرقض تثبيتها

 

[Barna]

3 دقائق مضت, كريمو2 said:

ثانيا يرقض تثبيتها

عند توفر جهاز حاسب .. انظر فيها

طيب جرب بقية الاحتمالات ... واعلمنا بها النظر بها جميعا ان شاء الله تعالى

[كريمو2]

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

طيب جرب بقية الاحتمالات ... واعلمنا بها النظر بها جميعا ان شاء الله تعالى

سأنظر فيها غدا بحول الله بالتجربة المملة لجميع الاحتمالات في مكان العمل ان شاء الله وسأوافيك بالرد  

[كريمو2]

كل شي تمام استاذ بقيت المشكلة التي اشرت لها في الرد السابق

[Barna]

2 ساعات مضت, كريمو2 said:

كل شي تمام استاذ بقيت المشكلة التي اشرت لها في الرد السابق

طيب الحمد لله ....

جرب كدة المشكلة السابقة واعلمنا بالنتيجة

 

BAR_A.mdb

[كريمو2]

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

جرب كدة المشكلة السابقة واعلمنا بالنتيجة

 

استاذ هل تم التعديل على الكود  هنا فقط

يعني "*النظارات*" تم استبدالها ب "*لا يمكن*"

' التحقق من استحقاق الامتياز قبل المتابعة
If (result Like "*كاملا*" And Not result Like "*لا يمكن*") Then
    ' طلب تأكيد تثبيت المنحة
    If MsgBox("هل تريد تثبيت تاريخ التعويض الطبي؟", vbYesNo + vbQuestion, "تأكيد") = vbYes Then

تم تعديل ديسمبر 18, 2024 بواسطه كريمو2

[Barna]

3 دقائق مضت, كريمو2 said:

استاذ هل تم التعديل على الكود  هنا فقط

نعم صحيح

[كريمو2]

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

نعم صحيح

شكرا استاذي الكريم على تعبك معي

الكود شغال 100 %

[كريمو2]

السلام عليكم  استاذ 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

تم تعديل الخميس at 15:41 بواسطه كريمو2

[كريمو2]

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