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

**كريمو2** · منذ 3 ساعات

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

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

1- الانخراط يكون اما بدفع القيمة كاملة مرة واحدة ( 3000 دج ) حلال السنة اي من شهر 01 الى شهر 08

2- وإما المبلغ ( 3000 دج ) يكون على ذفعتين اي (1500 دج) خلال شهر 3 و ( 1500 دج) خلال شهر 7

3- في حالة تم التسديد بستفيد المنحرط من كل المزايا

4- في حالة عدم التسديد لا يستفيد المعني بأي امتياز

وهنا يظهر المبساج "عزيزي العامل لا يمكنك الإستفادة من الإمتيازات لأنك لم تدفع مبلغ الإنخراط "

وشكرا

علما لديا هذه الدالة ولكن لاتؤدي وظيفتها على مايرام

Public Function GetInkhirat(ByRef ID As Integer) As Integer
On Error GoTo err_GetInkhirat
 Dim rst As DAO.Recordset
 Dim MySQL As String
    MySQL = ""
    MySQL = "SELECT DISTINCT(annee) FROM tbl_Loans "
    MySQL = MySQL & "WHERE EmployeeID = " & ID & "And Loan_ID = 0 "
    MySQL = MySQL & "GROUP BY annee"
    Set rst = CurrentDb.OpenRecordset(MySQL)
    rst.MoveLast: rst.MoveFirst
    Rec = rst.RecordCount
    GetInkhirat = Rec
    rst.Close: Set rst = Nothing
Exit Function
err_GetInkhirat:

    If Err.Number = 3021 Then 'Or Err.Number = 3061 Then
        'ignor, No Record
        Resume Next
    Else
        MsgBox Err.Number & vbCrLf & Err.Description
    End If

End Function
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
    
    If Month(Date) < 3 Then
       anne = Year(Date) - 1
    Else
       anne = Year(Date)
    End If
  
    sadad = IIf(DLookup("sadad", "tbl_Loans", "EmployeeID =" & ID & " And Year(tbl_Loans.Auto_Date) =" & anne) = True, True, False)

    If sadad = False Then Choix = 0: Exit Function
       Choix = 1
     
    If Month(Date) <= 3 Then: GetOther = True: Exit Function
    MySQL = ""
    MySQL = "SELECT tbl_Loans.Auto_ID, tbl_Loans.EmployeeID, tbl_Loans.Auto_Date, tbl_Loans.Loan_Type, tbl_Loans.Remarks, Year(tbl_Loans.Auto_Date) AS Dats"
    MySQL = MySQL & " FROM tbl_Loans"
    MySQL = MySQL & " WHERE tbl_Loans.Loan_Type ='Inkhirat'"
    MySQL = MySQL & " And tbl_Loans.EmployeeID =" & ID
    MySQL = MySQL & " And Year(tbl_Loans.Auto_Date) =" & Year(Date)
    MySQL = MySQL & " ORDER BY tbl_Loans.Auto_Date"
    'Debug.Print MySQL
    Set rst = CurrentDb.OpenRecordset(MySQL)
     
    rst.MoveLast: rst.MoveFirst
    Rec = rst.RecordCount
    If Month(Date) = 7 Then
    tot = DSum("Payment_Made", "tbl_Loans", "EmployeeID = " & ID & " And Year(Auto_Date) = " & Year(Date)) = 3000
    If Not tot Then GetOther = False: Exit Function
    End If
    If Rec = 0 Then
        GetOther = False
    Else
        GetOther = True
    End If
    
    'Debug.Print Adding
    rst.Close: Set rst = Nothing
      
Exit Function
err_GetOther:

    If Err.Number = 3021 Then 'Or Err.Number = 3061 Then
        'ignor, No Record
        Resume Next
    Else
        MsgBox Err.Number & vbCrLf & Err.Description
    End If

End Function

**Barna** · منذ 2 ساعات

منذ ساعه, كريمو2 said:

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

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

1- الانخراط يكون اما بدفع القيمة كاملة مرة واحدة ( 3000 دج ) حلال السنة اي من شهر 01 الى شهر 08

2- وإما المبلغ ( 3000 دج ) يكون على ذفعتين اي (1500 دج) خلال شهر 3 و ( 1500 دج) خلال شهر 7

3- في حالة تم التسديد بستفيد المنحرط من كل المزايا

4- في حالة عدم التسديد لا يستفيد المعني بأي امتياز

وهنا يظهر المبساج "عزيزي العامل لا يمكنك الإستفادة من الإمتيازات لأنك لم تدفع مبلغ الإنخراط "

وشكرا

علما لديا هذه الدالة ولكن لاتؤدي وظيفتها على مايرام

Public Function GetInkhirat(ByRef ID As Integer) As Integer
On Error GoTo err_GetInkhirat
 Dim rst As DAO.Recordset
 Dim MySQL As String
    MySQL = ""
    MySQL = "SELECT DISTINCT(annee) FROM tbl_Loans "
    MySQL = MySQL & "WHERE EmployeeID = " & ID & "And Loan_ID = 0 "
    MySQL = MySQL & "GROUP BY annee"
    Set rst = CurrentDb.OpenRecordset(MySQL)
    rst.MoveLast: rst.MoveFirst
    Rec = rst.RecordCount
    GetInkhirat = Rec
    rst.Close: Set rst = Nothing
Exit Function
err_GetInkhirat:

    If Err.Number = 3021 Then 'Or Err.Number = 3061 Then
        'ignor, No Record
        Resume Next
    Else
        MsgBox Err.Number & vbCrLf & Err.Description
    End If

End Function
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
    
    If Month(Date) < 3 Then
       anne = Year(Date) - 1
    Else
       anne = Year(Date)
    End If
  
    sadad = IIf(DLookup("sadad", "tbl_Loans", "EmployeeID =" & ID & " And Year(tbl_Loans.Auto_Date) =" & anne) = True, True, False)

    If sadad = False Then Choix = 0: Exit Function
       Choix = 1
     
    If Month(Date) <= 3 Then: GetOther = True: Exit Function
    MySQL = ""
    MySQL = "SELECT tbl_Loans.Auto_ID, tbl_Loans.EmployeeID, tbl_Loans.Auto_Date, tbl_Loans.Loan_Type, tbl_Loans.Remarks, Year(tbl_Loans.Auto_Date) AS Dats"
    MySQL = MySQL & " FROM tbl_Loans"
    MySQL = MySQL & " WHERE tbl_Loans.Loan_Type ='Inkhirat'"
    MySQL = MySQL & " And tbl_Loans.EmployeeID =" & ID
    MySQL = MySQL & " And Year(tbl_Loans.Auto_Date) =" & Year(Date)
    MySQL = MySQL & " ORDER BY tbl_Loans.Auto_Date"
    'Debug.Print MySQL
    Set rst = CurrentDb.OpenRecordset(MySQL)
     
    rst.MoveLast: rst.MoveFirst
    Rec = rst.RecordCount
    If Month(Date) = 7 Then
    tot = DSum("Payment_Made", "tbl_Loans", "EmployeeID = " & ID & " And Year(Auto_Date) = " & Year(Date)) = 3000
    If Not tot Then GetOther = False: Exit Function
    End If
    If Rec = 0 Then
        GetOther = False
    Else
        GetOther = True
    End If
    
    'Debug.Print Adding
    rst.Close: Set rst = Nothing
      
Exit Function
err_GetOther:

    If Err.Number = 3021 Then 'Or Err.Number = 3061 Then
        'ignor, No Record
        Resume Next
    Else
        MsgBox Err.Number & vbCrLf & Err.Description
    End If

End Function

حسب فهمي ... جرب هذا

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

    Dim yearNow As Integer
    Dim totalPaid As Currency
    Dim paymentMarch As Boolean
    Dim paymentJuly As Boolean

    ' تحديد السنة الحالية
    yearNow = Year(Date)
    
    ' إجمالي المبلغ المدفوع
    totalPaid = Nz(DSum("Payment_Made", "tbl_Loans", "EmployeeID = " & ID & " AND Year(Auto_Date) = " & yearNow), 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 totalPaid = 3000 Then
        CheckInkhirat = "عزيزي العامل، يمكنك الاستفادة من جميع الامتيازات لأنك دفعت مبلغ الانخراط كاملاً."
    ElseIf paymentMarch And paymentJuly Then
        CheckInkhirat = "عزيزي العامل، يمكنك الاستفادة من جميع الامتيازات لأنك دفعت مبلغ الانخراط كاملاً على دفعتين."
    Else
        CheckInkhirat = "عزيزي العامل، لا يمكنك الاستفادة من الامتيازات لأنك لم تدفع مبلغ الانخراط."
    End If

    Exit Function

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

يتم استدعاء الكود بهذا الشكل

Dim result As String
result = CheckInkhirat(EmployeeID)
MsgBox result

تسجيل الدخول

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

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

كريمو2

Barna

Join the conversation

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

تصفح الموقع

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

Support

Important Information