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

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

جرب هذا واعلمنا 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

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

تفضل ...................... 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

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

تم التجربة على كريمو 02 ظهرت رسالة اولى ثم موافق ظهرت الرسالة الاخيرة ... انظر .....

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

طيب جرب هذا 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

جرب هذا 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

حسب فهمي ... جرب هذا 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

اذا كان الهدف ليس تسلسل ولكن عدد فقط استخدم count

بارك الله فيك اخي الاستاذ @jjafferr شامم ريحة بخور .. من وين الريحة الزينة هذه ؟؟؟

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

اعمل استعلام تحديث الحقول المطلوبة

اشكرك اخي @شايب على التعقيب .... لذلك وضع له في البداية الكود الاول وحسب طلبه ادرجت الثاني انا دائما ( رأي شخصي ) اتردد في التعديل على الريجستري في برامجي .... هل هذا التردد في محله ؟ من وجهة نظر @شايب .... علما اني امتلك بفضل الله معلومات كافية حول ذلك ...

مشاركة مع البشمهندس @Foksh هل هذا هو المطلوب ....

تفضل Dim rst As DAO.Recordset Dim i As Long Dim RC As Long Set rst = Forms!fnumbermain!fnumbersub.Form.RecordsetClone rst.MoveLast: rst.MoveFirst RC = rst.RecordCount For i = 0 To RC - 1 rst.Edit rst!num = 1 + i rst.Update rst.MoveNext Next i rst.Close: Set rst = Nothing MsgBox "Done"

جرب هذا ..... Dim rst As DAO.Recordset Dim biggest_Number As Long Dim i As Long Dim RC As Long biggest_Number = Len(DMax("[num]", "fnumber")) Set rst = CurrentDb.OpenRecordset("Select * From fnumber") rst.MoveLast: rst.MoveFirst RC = rst.RecordCount For i = 0 To RC - 1 rst.Edit rst!num = 1 + i rst.Update rst.MoveNext Next i rst.Close: Set rst = Nothing MsgBox "Done"

اعملها بهذه الصورة ................

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

تفضل ملفك بعد التعديل ...................... base_r_BAR.accdb

هل فهمي صحيح للمطلوب ....

بارك الله فيك اخي @أبوبسمله للاسف الكود خاص باستاذنا @jjafferr وعلامة الاستفهام انا وضعتها عمدا حتى ينتبه لها السائل لان الكود يقوم بتجميع واخفاء الارقام المتشابهة حتى ولو كانت البيانات خاصة بمدرسة اخرى .....

جرب هذا ............. Private Sub buttonm_Click() Dim txtValue As String txtValue = Me.feildm.Value If txtValue Like "*[0-9]*" Then MsgBox "يوجد أرقام في مربع النص." Else MsgBox "لا يوجد أرقام في مربع النص." End If End Sub