منح قرض مالي او أجهزة كهرومتزلية بشرط

[كريمو2]

السلام عليكم اساتذة

تعديلا على الموضوع 

الرابط هنا

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

والان اريد زيادة القروض والادوات الكهرومنزلية اي منح الاستفادة منهما يشرط ان يكون منخرطا بدفع مبلغ مالي قيمة 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