اذهب الي المحتوي
أوفيسنا

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

كريمو2

بواسطه كريمو2
في قسم الأكسيس Access

 مشاركة
إذهب إلى أفضل إجابة Solved by Barna,

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

كريمو2

كريمو2

قام بنشر
قام بنشر

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

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

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

Barna

قام بنشر
قام بنشر
منذ ساعه, كريمو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

 

كريمو2

كريمو2

قام بنشر
  • الكاتب
قام بنشر

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

لاحط كيفية تم استدعاء الكود 

Private Sub CmdMenha_AfterUpdate()
Dim result As String
result = CheckInkhirat(EmployeeID)
MsgBox result
If MsgBox("هل تريد تثبيت تاريخ المنحة", vbYesNo) = vbYes Then
 Me.AwardMonth = Date
 Menha_Value = CmdMenha.Column(2)
 Me.Obsérvation = Nom_Menha
 Me.annee = Year(AwardMonth)
    Else
    Me.Undo
    End If
End Sub

وصحيح يظهر MsgBox يالتنيبه 

image.png.2a23d2253c16bfecf6d4a6041e28ae16.png

ولكن عنذ الضغط على زر موافق يقوم باعطائه الامتياز 

image.png.cf0c7e86f601824495ac15fed72566da.png

image.png.1fbaa7aac95ff404f596abf6f6eb61eb.png

فكيف يتم التعديل

Barna

Barna

قام بنشر
قام بنشر
4 ساعات مضت, كريمو2 said:

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

لاحط كيفية تم استدعاء الكود 

Private Sub CmdMenha_AfterUpdate()
Dim result As String
result = CheckInkhirat(EmployeeID)
MsgBox result
If MsgBox("هل تريد تثبيت تاريخ المنحة", vbYesNo) = vbYes Then
 Me.AwardMonth = Date
 Menha_Value = CmdMenha.Column(2)
 Me.Obsérvation = Nom_Menha
 Me.annee = Year(AwardMonth)
    Else
    Me.Undo
    End If
End Sub

وصحيح يظهر MsgBox يالتنيبه 

image.png.2a23d2253c16bfecf6d4a6041e28ae16.png

ولكن عنذ الضغط على زر موافق يقوم باعطائه الامتياز 

image.png.cf0c7e86f601824495ac15fed72566da.png

image.png.1fbaa7aac95ff404f596abf6f6eb61eb.png

فكيف يتم التعديل

جرب هذا  

Dim result As String

' استدعاء الدالة للتحقق من الانخراط
result = CheckInkhirat(EmployeeID)

' عرض النتيجة في رسالة تنبيه
MsgBox result, vbOKOnly + vbInformation, "تنبيه"

' طلب تأكيد تثبيت المنحة
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

 

كريمو2

كريمو2

قام بنشر
  • الكاتب
قام بنشر (معدل)
منذ ساعه, Barna said:

جرب هذا  

Dim result As String

' استدعاء الدالة للتحقق من الانخراط
result = CheckInkhirat(EmployeeID)

' عرض النتيجة في رسالة تنبيه
MsgBox result, vbOKOnly + vbInformation, "تنبيه"

' طلب تأكيد تثبيت المنحة
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

 

لم يغير شيئا التعديل استاذ

المطلوب عند ظهور الميساج

image.png.2a23d2253c16bfecf6d4a6041e28ae16.png

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

image.png.cf0c7e86f601824495ac15fed72566da.png

وهذا الاخير يتم ظهوره الا في حالة  الاستفادة فقط اي المنخرط

 

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

Barna

قام بنشر
قام بنشر

طيب جرب هذا 

Dim result As String
Dim userResponse As VbMsgBoxResult

' استدعاء الدالة للتحقق من الانخراط
result = CheckInkhirat(EmployeeID)

' عرض النتيجة في رسالة
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, "تنبيه"
End If

 

Barna

Barna

قام بنشر
قام بنشر

الواضح من جدول الدفعات ان كريمو قد دفع المبلغ كاملا  .... انظر 

والدليل غير الرقم 3000 الى 2000 انظر النتيجة
 

1.jpg

2.jpg

كريمو2

كريمو2

قام بنشر
  • الكاتب
قام بنشر (معدل)

01- قبل التعديل على الملف يجب مراعاة هذا الشرظ 

totalPaid = Nz(DSum("Payment_Made", "tbl_Loans", "EmployeeID = " & ID & " AND Year(Auto_Date) = " & yearNow), 0)

 كيف يتم زيادة هذا الشرط Loan_ID = 0 للدالة  totalPaid علما ان الفلترة  0 يخص الانخراط فقط 
 

02- كريمو 1 منخرط جرب في كريمو  2 او  3

 

 

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

Barna

قام بنشر
قام بنشر
7 دقائق مضت, كريمو2 said:

01- قبل التعديل على الملف يجب مراعاة هذا الشرظ

totalPaid = Nz(DSum("Payment_Made", "tbl_Loans", "EmployeeID = " & ID & " AND Year(Auto_Date) = " & yearNow), 0)
 كيف يتم زيادة هذا الشرط Loan_ID = 0 للدالة  totalPaid علما ان الفلترة  0 يخص الانخراط فقط 
 

02- كريمو01 منخرط جرب في كريمو 02 او 03

 

 

تم التجربة على كريمو 02

ظهرت رسالة اولى ثم موافق ظهرت الرسالة الاخيرة ... انظر .....

 

1.jpg

2.jpg

كريمو2

كريمو2

قام بنشر
  • الكاتب
قام بنشر (معدل)

الرسالة الثانية لم تظهر لي استاذ عند التعديل

2.jpg

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

Barna

قام بنشر
قام بنشر
3 ساعات مضت, كريمو2 said:

انظر الفيديو 

 

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

والفيديو الثاني يبين دحول الكود الى تثبيت المنحة

طيب ... جرب كده .....

 

20241128.mdb

كريمو2

كريمو2

قام بنشر
  • الكاتب
قام بنشر

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

ولكن الشرط  Loan_ID = 0 لم تقم بإضافته للدالة

totalPaid = Nz(DSum("Payment_Made", "tbl_Loans", "EmployeeID = " & ID & " AND Year(Auto_Date) = " & yearNow), 0)
 

علما ان الجدول tbl_Loans فيه الانخراطات والقروض وغيرها يلزم الشرط

  • أفضل إجابة
Barna

Barna

قام بنشر
  • أفضل إجابة
قام بنشر
11 دقائق مضت, كريمو2 said:

ولكن الشرط  Loan_ID = 0 لم تقم بإضافته للدالة

تفضل ...................... 

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)
    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 totalPaid = 3000 And paymentMarch = False And paymentJuly = False Then
        CheckInkhirat = "عزيزي العامل، يمكنك الاستفادة من جميع الامتيازات لأنك دفعت مبلغ الانخراط كاملاً."
    ElseIf totalPaid = 3000 And paymentMarch = True And paymentJuly = True Then
        CheckInkhirat = "عزيزي العامل، يمكنك الاستفادة من جميع الامتيازات لأنك دفعت مبلغ الانخراط كاملاً على دفعتين."
    Else
        CheckInkhirat = "عزيزي العامل، لا يمكنك الاستفادة من الامتيازات لأنك لم تدفع مبلغ الانخراط."
    End If

    Exit Function

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

 

  • Like 1
كريمو2

كريمو2

قام بنشر
  • الكاتب
قام بنشر

شكر استاذي العزيز Barna

على المساعدة الله يجعلها في ميزان حسناتك

كما نتمنى من إدارة المنتدي تصحيح العنوان لانه به اخطاء

  • Thanks 1
Barna

Barna

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

2025.jpg

ممكن تدخل بعض تلك الاحتمالات في الجدول .... وتوضح ماذا تريد بالضبط من نتائج

كريمو2

كريمو2

قام بنشر
  • الكاتب
قام بنشر (معدل)
27 دقائق مضت, Barna said:

ممكن تدخل بعض تلك الاحتمالات في الجدول .... وتوضح ماذا تريد بالضبط من نتائج

استاذ الملف الي بحوزتك غير سنة الجهاز الى 2025 والشهر الى  01

وحاول منح امتياز للعامل كريمو 1 الذي تم قبول امتياز له خلال 2024 بحكم انه منخرط في 2024

اما دخول سنة 2025 فهو غير منخرط الى غاية انخراطه في شهر 3

هل الكود يعطيه الحق في الامتياز خلال شهر 1 و 2 و 3 من 2025

المطلوب تعديل الى غاية شهر 3 من كل سنة جديدة

امل اني وفقت في توضيح المطلوب استاذي الكريم 

2025.20-51.jpg.7384ad21017b804aaaaddb42abd97336.jpg

 

 

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

Barna

قام بنشر
قام بنشر
48 دقائق مضت, كريمو2 said:

هل الكود يعطيه الحق في الامتياز خلال شهر 1 و 2 و 3 من 2025

المطلوب تعديل الى غاية شهر 3 من كل سنة جديدة

جرب هذا واعلمنا  

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

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

    ' تحديد السنة الحالية والسنة التالية
    yearNow = Year(Date)
    yearNext = yearNow + 1

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

    Exit Function

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

 

كريمو2

كريمو2

قام بنشر
  • الكاتب
قام بنشر

استاذ إنتابتني فكرة حول هذه الدالة GetOther لأنها تفي بالغرض المطلوب في  الدالة القديمة

راجعها او حاول ادماجها مع الدالة الجديدة 

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

 

Barna

Barna

قام بنشر
قام بنشر
في 1‏/12‏/2024 at 13:21, كريمو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 paymentMarch As Boolean
    Dim paymentJuly As Boolean

    ' تحديد السنة الحالية
'yearNow = Year(Date)
If Month(Date) < 3 Then
       yearNow = Year(Date) - 1
    Else
       yearNow = Year(Date)
    End If

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

    Exit Function

err_CheckInkhirat:
    MsgBox "خطأ رقم " & Err.Number & ": " & Err.Description, vbCritical, "خطأ"
    CheckInkhirat = "حدث خطأ أثناء التحقق من بيانات الانخراط."
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

 

كريمو2

كريمو2

قام بنشر
  • الكاتب
قام بنشر

شكرا استاذي العزيز  وهو كذلك 

جربت الى غاية شهر 1 و 2 من السنة الجديدة  الكود يستجيب للإمتياز

اما شهر 3 فلا يستجيب وهو الاصح

الان ممكن  إضافة "MsgBox" يعلمني ان العامل بإمكانه الاستفادة لأنه منخرط خلال السنة الماضية

يظهر خلال شهر 1 و 2 فقط من السنة الجديدة 

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
 مشاركة
الذهاب الي قائمه المواضيع

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

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information

  I accept