اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

التعديل على دالة مهمتها التنبيه وظهور 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

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