التعديل على دالة مهمتها التنبيه وظهور MsgBox بشرط

**ابو جودي** · ديسمبر 1

بعد اذن استاذى الجليل ومعلمى القدير واخى الحبيب الاستاذ @Barna :fff:
على حسب فهمى المطلوب الان تحديدا هو :
مراعاة منح الامتياز للمنخرطين من السنة الماضية خلال الأشهر 1، 2، و3، مع عدم منح الامتياز بعد شهر 3 إذا لم يتم التسديد خلال السنة الحالية

اذا انا فهمت صح جرب الكود التالى

' Function to check membership payment details and determine benefits eligibility
Public Function CheckInkhirat(ByRef ID As Integer) As String
    On Error GoTo err_CheckInkhirat

    Dim currentYear As Integer
    Dim previousYear As Integer
    Dim totalPaid As Currency
    Dim paymentMarch As Boolean
    Dim paymentJuly As Boolean
    Dim currentMonth As Integer

    ' Get the current year and month
    currentMonth = Month(Date)
    If currentMonth < 4 Then
        currentYear = Year(Date) - 1
        previousYear = currentYear - 1
    Else
        currentYear = Year(Date)
        previousYear = currentYear - 1
    End If

    ' Calculate total payments for the current year
    totalPaid = Nz(DSum("Payment_Made", "tbl_Loans", "EmployeeID = " & ID & " AND Year(Auto_Date) = " & currentYear & " AND Loan_ID = 0"), 0)

    ' Check if partial payments were made in March and July
    paymentMarch = Nz(DLookup("Payment_Made", "tbl_Loans", "EmployeeID = " & ID & " AND Year(Auto_Date) = " & currentYear & " AND Month(Auto_Date) = 3"), 0) = 1500
    paymentJuly = Nz(DLookup("Payment_Made", "tbl_Loans", "EmployeeID = " & ID & " AND Year(Auto_Date) = " & currentYear & " AND Month(Auto_Date) = 7"), 0) = 1500

    ' Grant benefits if paid full or in two installments within the allowed period
    If totalPaid = 3000 And Not paymentMarch And Not paymentJuly Then
        CheckInkhirat = "You are eligible for all benefits as you paid the full membership amount in one payment."
    ElseIf totalPaid = 3000 And paymentMarch And paymentJuly Then
        CheckInkhirat = "You are eligible for all benefits as you paid the membership amount in two installments."
    ElseIf currentMonth <= 3 Then
        ' Check for benefits based on the previous year's payment status
        Dim previousTotalPaid As Currency
        previousTotalPaid = Nz(DSum("Payment_Made", "tbl_Loans", "EmployeeID = " & ID & " AND Year(Auto_Date) = " & previousYear & " AND Loan_ID = 0"), 0)
        
        If previousTotalPaid = 3000 Then
            CheckInkhirat = "You are eligible for benefits due to your membership payment in the previous year."
        Else
            CheckInkhirat = "You are not eligible for benefits as your membership payment is incomplete."
        End If
    Else
        ' If not meeting conditions, no benefits granted
        CheckInkhirat = "You are not eligible for benefits as your membership payment is incomplete."
    End If

    Exit Function

err_CheckInkhirat:
    MsgBox "Error " & Err.Number & ": " & Err.Description, vbCritical, "Error"
    CheckInkhirat = "An error occurred while checking membership details."
End Function


' Function to verify other payment-related conditions
Public Function GetOther(ByRef ID As Integer) As Boolean
    On Error GoTo err_GetOther

    Dim rst As DAO.Recordset
    Dim MySQL As String
    Dim sadad As Boolean
    Dim anne As Integer
    Dim Rec As Integer
    Dim tot As Boolean

    ' Determine the current year based on the month
    If Month(Date) < 3 Then
        anne = Year(Date) - 1
    Else
        anne = Year(Date)
    End If

    ' Check if the payment status (sadad) is true for the current year
    sadad = Nz(DLookup("sadad", "tbl_Loans", "EmployeeID = " & ID & " AND Year(Auto_Date) = " & anne), False)

    If Not sadad Then
        GetOther = False
        Exit Function
    End If

    ' Query the loan records for the current year
    MySQL = "SELECT Auto_ID, EmployeeID, Auto_Date, Loan_Type, Remarks, Year(Auto_Date) AS Dats " & _
            "FROM tbl_Loans " & _
            "WHERE Loan_Type = 'Inkhirat' AND EmployeeID = " & ID & " AND Year(Auto_Date) = " & Year(Date) & _
            " ORDER BY Auto_Date"

    Set rst = CurrentDb.OpenRecordset(MySQL)

    ' Check record count
    If Not rst.EOF Then rst.MoveLast
    If Not rst.BOF Then rst.MoveFirst
    Rec = rst.RecordCount

    ' Additional checks for July
    If Month(Date) = 7 Then
        tot = (Nz(DSum("Payment_Made", "tbl_Loans", "EmployeeID = " & ID & " AND Year(Auto_Date) = " & Year(Date)), 0) = 3000)
        If Not tot Then
            GetOther = False
            rst.Close
            Exit Function
        End If
    End If

    GetOther = (Rec > 0)

    rst.Close
    Set rst = Nothing
    Exit Function

err_GetOther:
    If Err.Number = 3021 Then ' No records found
        Resume Next
    Else
        MsgBox "Error " & Err.Number & ": " & Err.Description, vbCritical, "Error"
    End If
End Function

يحتوي الكود على الدالتين:

CheckInkhirat

تتحقق من دفع رسوم الانخراط إما دفعة واحدة أو على دفعتين خلال السنة الحالية

تضيف شرط السماح بالاستفادة من الامتيازات بناءً على الدفع في السنة السابقة، إذا كان الشهر الحالي أقل من أبريل

GetOther

تتحقق من شروط أخرى تتعلق بالاشتراك، مثل حالة الدفع (مؤشر sadad) والتحقق من سجلات القروض (Loans) للسنة الحالية

تأكيد النقاط المحققة في الكود

الشروط الزمنية للدفعات:

شرط أن يتم دفع 3000 دج خلال الفترة من يناير إلى أغسطس

أو دفع 1500 دج في مارس و1500 دج في يوليو

الامتياز للسنة السابقة

عند الدخول في السنة الجديدة يمكن للمنخرطين في السنة السابقة الاستفادة خلال الأشهر الثلاثة الأولى (يناير، فبراير، مارس).

**كريمو2** · ديسمبر 1

شكرا استاذ ابو جودي على الرد

حاولت نسخ الكود في موديل جديد للمقارنة

1071603134_.png.3818c6971f8c35ce043c2478b22a8212.png

**Barna** · ديسمبر 1

1 ساعه مضت, ابو جودي said:

بعد اذن استاذى الجليل ومعلمى القدير واخى الحبيب الاستاذ @Barna

هلا بالبشمهندس محمد ..... هل يستأذن اخي الغالي صاحب الدار .... بل يسلم ويدخل الدار بارك الله فيه

جرب هذا الكود اخي @كريمو2

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

    Dim yearNow As Integer
    Dim totalPaid As Currency
    Dim totalPaidLastYear As Currency
    Dim paymentMarch As Boolean
    Dim paymentJuly As Boolean
    Dim t As Integer
    
    ' تحديد السنة
    If Month(Date) < 3 Then
        yearNow = Year(Date) - 1
         t = 1
    Else
        yearNow = Year(Date)
         t = 2
    End If
    
    'إجمالي المبلغ المدفوع
    totalPaid = Nz(DSum("Payment_Made", "tbl_Loans", "EmployeeID = " & ID & " AND Year(Auto_Date) = " & yearNow & " AND Loan_ID = 0"), 0)

    ' التحقق من دفع المبلغ في مارس ويوليو للسنة الحالية
    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 t = 2 And totalPaid = 3000 And paymentMarch = False And paymentJuly = False Then
        CheckInkhirat = "عزيزي العامل، يمكنك الاستفادة من جميع الامتيازات لأنك دفعت مبلغ الانخراط كاملاً."
    ElseIf t = 2 And totalPaid = 3000 And paymentMarch = True And paymentJuly = True Then
        CheckInkhirat = "عزيزي العامل، يمكنك الاستفادة من جميع الامتيازات لأنك دفعت مبلغ الانخراط كاملاً على دفعتين."
    ElseIf t = 1 And totalPaid = 3000 Then
        CheckInkhirat = "عزيزي العامل، يمكنك الاستفادة من الامتيازات لأنك دفعت مبلغ الانخراط الخاص بالسنة الماضية كاملاً."
    Else
        CheckInkhirat = "عزيزي العامل، لا يمكنك الاستفادة من الامتيازات لأنك لم تدفع مبلغ الانخراط."
    End If
    Exit Function

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

**ابو جودي** · ديسمبر 1

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

حاولت نسخ الكود في موديل جديد للمقارنة

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

انت بس اخدت النسخ بدون العلامة لذلك ظهر باللون الاحمر فا يا اما تضيف العلامة التالية للسطر : ' او تحذفه نهائينا لو لم تريد شرح او تلميح عن الوظيفة :wink2:

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

هلا بالبشمهندس محمد ..... هل يستأذن اخي الغالي صاحب الدار .... بل يسلم ويدخل الدار بارك الله فيه

هلا والله ..... والله اشتقنا

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

**كريمو2** · ديسمبر 1

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

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

    Dim yearNow As Integer
    Dim totalPaid As Currency
    Dim totalPaidLastYear As Currency
    Dim paymentMarch As Boolean
    Dim paymentJuly As Boolean
    Dim t As Integer
    
    ' تحديد السنة
    If Month(Date) < 3 Then
        yearNow = Year(Date) - 1
         t = 1
    Else
        yearNow = Year(Date)
         t = 2
    End If
    
    'إجمالي المبلغ المدفوع
    totalPaid = Nz(DSum("Payment_Made", "tbl_Loans", "EmployeeID = " & ID & " AND Year(Auto_Date) = " & yearNow & " AND Loan_ID = 0"), 0)

    ' التحقق من دفع المبلغ في مارس ويوليو للسنة الحالية
    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 t = 2 And totalPaid = 3000 And paymentMarch = False And paymentJuly = False Then
        CheckInkhirat = "عزيزي العامل، يمكنك الاستفادة من جميع الامتيازات لأنك دفعت مبلغ الانخراط كاملاً."
    ElseIf t = 2 And totalPaid = 3000 And paymentMarch = True And paymentJuly = True Then
        CheckInkhirat = "عزيزي العامل، يمكنك الاستفادة من جميع الامتيازات لأنك دفعت مبلغ الانخراط كاملاً على دفعتين."
    ElseIf t = 1 And totalPaid = 3000 Then
        CheckInkhirat = "عزيزي العامل، يمكنك الاستفادة من الامتيازات لأنك دفعت مبلغ الانخراط الخاص بالسنة الماضية كاملاً."
    Else
        CheckInkhirat = "عزيزي العامل، لا يمكنك الاستفادة من الامتيازات لأنك لم تدفع مبلغ الانخراط."
    End If
    Exit Function

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

الكوذ وقع به خلل عند الاستدعاء استاذ

2026.jpg.cd5a004d87d82e493b562904adeb3ed3.jpg

تم تعديل ديسمبر 1 بواسطه كريمو2

**Barna** · ديسمبر 1

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

الكوذ وقع به خلل عند الاستدعاء استاذ

يبدو انك مكرر اسم الدالة لديك ابحث عنها ( اما تغير اسمائها او تحذف القديم الذي لا تحتاجه )

تم تعديل ديسمبر 1 بواسطه Barna

**كريمو2** · ديسمبر 2

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

يبدو انك مكرر اسم الدالة لديك ابحث عنها ( اما تغير اسمائها او تحذف القديم الذي لا تحتاجه )

وهو كذلك وجدت الدالة مكررة

شكرا لك استاذي على يد المساعدة حفظك الله ورعاك

**كريمو2** · ديسمبر 5

ممكن اضافة الدالة هذه وعند ظهور Msgbox لا يحدث سجل منح

' استدعاء الدالة للتحقق من منحة الحج
f = DCount("year(Menha_Date)", "Mena7", "EmployeeID=" & Me.EmployeeID)
If f >= 1 And Me.Menha_ID = "11" Then
     MsgBox " هذا المنحرط (ة) استفاد بمنحة الحج لسنة :" & "" & years, vbExclamation, "تنبيه"
    Me.Undo
 End If

الى الدالة

Private Sub CmdMenha_AfterUpdate()
Dim result As String
Dim userResponse As VbMsgBoxResult
Dim emp As Integer
emp = EmployeeID
' استدعاء الدالة للتحقق من الانخراط
result = CheckInkhirat(emp)
' عرض النتيجة في رسالة
userResponse = MsgBox(result, vbOKOnly + vbInformation, "نتيجة التحقق")

' التحقق من استحقاق الامتياز قبل المتابعة
If result Like "*كاملا*" Then
    ' طلب تأكيد تثبيت المنحة
    If MsgBox("هل تريد تثبيت تاريخ المنحة؟", vbYesNo + vbQuestion, "تأكيد") = vbYes Then
        ' إذا وافق المستخدم، يتم تثبيت التاريخ وإكمال العملية
        Me.AwardMonth = DATE
        Me.Menha_Value = CmdMenha.Column(2)
        Me.Obsérvation = Nom_Menha
        Me.annee = year(Me.AwardMonth)
    Else
        ' إذا رفض المستخدم، يتم التراجع عن أي تغييرات
        Me.Undo
    End If
Else
    ' إذا لم يتم استيفاء شروط الانخراط، لا يمكن تثبيت المنحة
    MsgBox "لا يمكنك تثبيت المنحة لأن شروط الانخراط غير مستوفاة.", vbExclamation, "تنبيه"
    Me.Undo
End If

End Sub

علما ان المنحة رقم 11 تعني الحج وتعطى مرة واحدة فقط

**Barna** · ديسمبر 6

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

ممكن اضافة الدالة هذه وعند ظهور Msgbox لا يحدث

جرب هذا ...

Private Sub CmdMenha_AfterUpdate()
    Dim result As String
    Dim userResponse As VbMsgBoxResult
    Dim emp As Integer
    Dim f As Integer
    
    emp = EmployeeID
    
    ' استدعاء الدالة للتحقق من الانخراط
    result = CheckInkhirat(emp)
    
    ' عرض النتيجة في رسالة
    userResponse = MsgBox(result, vbOKOnly + vbInformation, "نتيجة التحقق")
    
    ' التحقق من منحة الحج
    f = DCount("year(Menha_Date)", "Mena7", "EmployeeID=" & Me.EmployeeID)
    If f >= 1 And Me.Menha_ID = "11" Then
        MsgBox "هذا المنخرط (ة) استفاد بمنحة الحج لسنة :" & "" & Year(Me.Menha_Date), vbExclamation, "تنبيه"
        Me.Undo
        Exit Sub
    End If
    
    ' التحقق من استحقاق الامتياز قبل المتابعة
    If result Like "*كاملا*" Then
        ' طلب تأكيد تثبيت المنحة
        If MsgBox("هل تريد تثبيت تاريخ المنحة؟", vbYesNo + vbQuestion, "تأكيد") = vbYes Then
            ' إذا وافق المستخدم، يتم تثبيت التاريخ وإكمال العملية
            Me.AwardMonth = Date
            Me.Menha_Value = CmdMenha.Column(2)
            Me.Obsérvation = Nom_Menha
            Me.annee = Year(Me.AwardMonth)
        Else
            ' إذا رفض المستخدم، يتم التراجع عن أي تغييرات
            Me.Undo
        End If
    Else
        ' إذا لم يتم استيفاء شروط الانخراط، لا يمكن تثبيت المنحة
        MsgBox "لا يمكنك تثبيت المنحة لأن شروط الانخراط غير مستوفاة.", vbExclamation, "تنبيه"
        Me.Undo
    End If
End Sub

**كريمو2** · ديسمبر 6

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

الكود به مشكلة لاحظ الفيديو

2024-12-06_13-53-56.rar

20241205.rar

تم تعديل ديسمبر 6 بواسطه كريمو2

**Eng.Qassim** · ديسمبر 6

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

الكود به مشكلة لاحظ الفيديو

السلام عليكم..

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

على كل حال... اخي العزيز @كريمو2... الخطأ يظهر لان حقل تاريخ المنحة فارغ او Null

ضع الكود التالي للتحقق من فراغ حقل التاريخ:

' التحقق من منحة الحج
    f = DCount("year(Menha_Date)", "Mena7", "EmployeeID=" & Me.EmployeeID)
    If f >= 1 And Me.Menha_ID = "11" Then
         If IsDate(Me.Menha_Date) Then
         MsgBox "هذا المنخرط (ة) استفاد بمنحة الحج لسنة : " & Year(Me.Menha_Date), vbExclamation, "تنبيه"
            Else
            MsgBox "يرجى وضع التاريخ في حقل تاريخ المنحة.", vbCritical, "خطأ"
         End If
        
        Me.Undo
        Exit Sub
    End If

تحياتي للجميع

**كريمو2** · ديسمبر 6

58 دقائق مضت, Eng.Qassim said:

' التحقق من منحة الحج
    f = DCount("year(Menha_Date)", "Mena7", "EmployeeID=" & Me.EmployeeID)
    If f >= 1 And Me.Menha_ID = "11" Then
         If IsDate(Me.Menha_Date) Then
         MsgBox "هذا المنخرط (ة) استفاد بمنحة الحج لسنة : " & Year(Me.Menha_Date), vbExclamation, "تنبيه"
            Else
            MsgBox "يرجى وضع التاريخ في حقل تاريخ المنحة.", vbCritical, "خطأ"
         End If
        
        Me.Undo
        Exit Sub
    End If

منذ ساعه, Eng.Qassim said:

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

شكرا استاذ Eng.Qassim على الرد والاهتمام

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

تم التعديل على اضافة التاريخ

    ' التحقق من منحة الحج
     Me.AwardMonth = Date
    f = DCount("year(Menha_Date)", "Mena7", "EmployeeID=" & Me.EmployeeID)
    If f >= 1 And Me.Menha_ID = "11" Then
         If IsDate(Me.Menha_Date) Then
         MsgBox "هذا المنخرط (ة) استفاد بمنحة الحج لسنة : " & Year(Me.Menha_Date), vbExclamation, "تنبيه"
            Else
'            MsgBox "يرجى وضع التاريخ في حقل تاريخ المنحة.", vbCritical, "خطأ"
         End If      
        Me.Undo
        Exit Sub
    End If

ولكن الكود لم يبحث عن سنة الاستفادة annee في الجدول Mena7

image.png.c541566c9131df7477c1c72d05519e1f.png

**Eng.Qassim** · ديسمبر 6

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

ولكن الكود لم يبحث عن سنة الاستفادة annee في الجدول Mena7

شكرا لجميل دعائك اخي الكريم..

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

سأحاول لاحقا ان اسعفتني حالتي الصحية ..عافاكم الله من كل سوء

**Barna** · ديسمبر 7

في 6‏/12‏/2024 at 19:03, كريمو2 said:

ولكن الكود لم يبحث عن سنة الاستفادة annee في الجدول Mena7

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

**كريمو2** · ديسمبر 8

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

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

اي فعلا استاذ كما أشرت

**Barna** · ديسمبر 9

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

اي فعلا استاذ كما أشرت

20241205.mdb

**كريمو2** · ديسمبر 9

شكرا استاذي العزيز Barna على بذل المجهودات والابتكارات في الأكواد

تم تعديل ديسمبر 9 بواسطه كريمو2

**كريمو2** · ديسمبر 10

استاذ وقعت لي مشكلة عند اختيار

01- المنحة المدرسة

02- التعوبضات الطبية

03- المساعدات

04-العمرة

كما في الصورة

2097156342_.png.f4b01c74ddfa2eaa62e004a2be8c894d.png

**Barna** · ديسمبر 10

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

وقعت لي مشكلة عند اختيار

تفضل ......

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

    Dim yearNow As Integer
    Dim totalPaid As Currency
    Dim totalPaidLastYear As Currency
    Dim paymentMarch As Boolean
    Dim paymentJuly As Boolean
    Dim t As Integer
    Dim result_haj As Variant
    ' تحديد السنة
    If Month(Date) < 3 Then
        yearNow = Year(Date) - 1
         t = 1
    Else
        yearNow = Year(Date)
         t = 2
    End If
    
    'إجمالي المبلغ المدفوع
    totalPaid = Nz(DSum("Payment_Made", "tbl_Loans", "EmployeeID = " & ID & " AND Year(Auto_Date) = " & yearNow & " AND Loan_ID = 0"), 0)
    If [Forms]![FrmMenah]![Etar] = "المنح العائلية" Then
    
    'التحقق من منحة الحج
    result_haj = DLookup("[Menha_Date]", "[Mena7]", "[EmployeeID] =" & ID & " And [Menha_ID] =" & [Forms]![FrmMenah]![Frm_sub].[Form]![CmdMenha] & "  And [Menha_ID] =11 ")
    Else
    result_haj = Null
    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 t = 2 And totalPaid = 3000 And paymentMarch = False And paymentJuly = False And IsNull(result_haj) Then
        CheckInkhirat = "عزيزي العامل، يمكنك الاستفادة من جميع الامتيازات لأنك دفعت مبلغ الانخراط كاملاً."
    ElseIf t = 2 And totalPaid = 3000 And paymentMarch = True And paymentJuly = True And IsNull(result_haj) Then
        CheckInkhirat = "عزيزي العامل، يمكنك الاستفادة من جميع الامتيازات لأنك دفعت مبلغ الانخراط كاملاً على دفعتين."
    ElseIf t = 1 And totalPaid = 3000 Then
        CheckInkhirat = "عزيزي العامل، يمكنك الاستفادة من الامتيازات لأنك دفعت مبلغ الانخراط الخاص بالسنة الماضية كاملاً."
    'التحقق من رسائل الحج
    ElseIf t = 1 And totalPaid = 3000 And Not IsNull(result_haj) Then
        CheckInkhirat = "عزيزي العامل، يمكنك الاستفادة من الامتيازات لأنك دفعت مبلغ الانخراط الخاص بالسنة الماضية كاملاً." & vbNewLine & "ولكن قد استفت من منحة الحج لعام" & vbNewLine & result_haj
    ElseIf t = 2 And totalPaid = 3000 And paymentMarch = False And paymentJuly = False And Not IsNull(result_haj) Then
        CheckInkhirat = "عزيزي العامل، يمكنك الاستفادة من جميع الامتيازات لأنك دفعت مبلغ الانخراط كاملاً." & vbNewLine & "ولكن قد استفت من منحة الحج لعام" & vbNewLine & result_haj
    ElseIf t = 2 And totalPaid = 3000 And paymentMarch = True And paymentJuly = True And Not IsNull(result_haj) Then
        CheckInkhirat = "عزيزي العامل، يمكنك الاستفادة من جميع الامتيازات لأنك دفعت مبلغ الانخراط كاملاً على دفعتين." & vbNewLine & "ولكن قد استفت من منحة الحج لعام" & vbNewLine & result_haj

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

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

**كريمو2** · ديسمبر 10

شكرا استاذ على التعديل

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

الشروط يعطي هذا التعويض للشخص الواحد مرة واحدة خلال كل 02 سنة

البداية :

1- اختيار نوع ورقم التعويضات الطبية ونختار رقم 2

2- تثبيت تاريخ التعويض

3- اسم الشخص صاحب النظارات الطبية هنا يظهر MsgBox في حالة نفس الشخص ولم يتم السنتين(02)

4- ادحال مبلغ الفاتورة ملاحظة " في حالة المبلغ اكبر من 70000.00دج يحسب على 70000.00 دج" اي هي المرجع

5- النسبة تكون : 40%

011.jpg.dabbf16ae72a8cdf111d9e2d5b54b0ea.jpg

أتمنى اني وفقت في شرح المطلوب

المرفق بحوزتك حاول التجريب والتعديل عليه

**Barna** · ديسمبر 10

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

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

الشروط يعطي هذا التعويض للشخص الواحد مرة واحدة خلال كل 02 سنة

البداية :

1- اختيار نوع ورقم التعويضات الطبية ونختار رقم 2

2- تثبيت تاريخ التعويض

3- اسم الشخص صاحب النظارات الطبية هنا يظهر MsgBox في حالة نفس الشخص ولم يتم السنتين(02)

4- ادحال مبلغ الفاتورة ملاحظة " في حالة المبلغ اكبر من 70000.00دج يحسب على 70000.00 دج" اي هي المرجع

5- النسبة تكون : 40%

اخي الكريم ... شروطك اختلفت عن السابق .... لذا وجب عليك فتح موضوع جديد مع التعريض بهذا الموضوع ... تجد الإجابة مني أو أحد الزملاء في المنتدى

تسجيل الدخول

التعديل على دالة مهمتها التنبيه وظهور MsgBox بشرط

الردود الموصى بها

ابو جودي

كريمو2

Barna

ابو جودي

كريمو2

Barna

كريمو2

كريمو2

Barna

كريمو2

Eng.Qassim

كريمو2

Eng.Qassim

Barna

كريمو2

Barna

كريمو2

كريمو2

Barna

كريمو2

Barna

Join the conversation

تصفح هذا الموضوع مؤخراً 0 اعضاء متواجدين الان

تصفح الموقع

تصفح جديد الموقع

Support

Important Information