Barna

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

اخي الكريم @saffar ممكن توضيح لفكرتك باسهاب ........

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

طيب ... الحمدلله رب العالمين

طيب جرب واعلمنا بالنتيجة ..... استخدم هذا الامر تحت زر تفريغ على الجدول ..... Dim strField As String Dim regex As Object Dim matches As Object Dim match As Variant Dim cleanedValue As String Dim FullText As String Dim FirstPhrase, SecondPhrase As String Dim RemainingText As String Set regex = CreateObject("VBScript.RegExp") regex.Global = True regex.IgnoreCase = True strField = Me.a regex.Pattern = "الوزن:\d+|\d+\s*\$\s*اجار شاحنة|\d+\s*\$\s*عمال|\d+\s*\$\s*رسوم|\d+\s*\$\s*وصل|\d+\s*\$\s*خدمات|العدد:\d+" Set matches = regex.Execute(strField) FirstPhrase = Split(strField, "المادة")(0) SecondPhrase = Split(strField, "العدد")(0) RemainingText = Replace(SecondPhrase, FirstPhrase & "المادة", "") FirstPhrase = Replace(FirstPhrase, "السيد", "") DoCmd.OpenForm "Test1", , , , acFormAdd Forms!Test1.Form.Recordset.AddNew For Each match In matches cleanedValue = Replace(match.Value, "$", "") cleanedValue = Replace(cleanedValue, "الوزن:", "") cleanedValue = Replace(cleanedValue, "رسوم", "") cleanedValue = Replace(cleanedValue, "وصل", "") cleanedValue = Replace(cleanedValue, "خدمات", "") cleanedValue = Replace(cleanedValue, "عمال", "") cleanedValue = Replace(cleanedValue, "اجار شاحنة", "") cleanedValue = Replace(cleanedValue, "العدد:", "") cleanedValue = Trim(cleanedValue) If InStr(match.Value, "الوزن:") > 0 Then Forms![Test1]![d].Value = cleanedValue ElseIf InStr(match.Value, "عمال") > 0 Then Forms![Test1]![g].Value = cleanedValue ElseIf InStr(match.Value, "وصل") > 0 Then Forms![Test1]![e].Value = cleanedValue ElseIf InStr(match.Value, "خدمات") > 0 Then Forms![Test1]![f].Value = cleanedValue ElseIf InStr(match.Value, "اجار شاحنة") > 0 Then Forms![Test1]![h].Value = cleanedValue ElseIf InStr(match.Value, "العدد:") > 0 Then Forms![Test1]![c].Value = cleanedValue End If Next match Forms![Test1]![a].Value = FirstPhrase Forms![Test1]![b].Value = RemainingText

اقصد هذه المسميات والعلامات ...

طيب ... بارك الله فيك ... هل دائما تنسيق الرسالة بالطريقة الموجودة في المرفق

وعليكم السلام ورحمة الله وبركاته انشأ وحدة نمطية وضع التالي بها :::: Public Sub CheckEntryLanguage(TB As TextBox, Txt As String) If InStr("ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz", Txt) > 0 Then TB.KeyboardLanguage = 3 MsgBox "يحب ان تكتب بالعربي .. مع العلم أنه تم تغيير اللغة للوحة المفاتيح." TB = "" End If End Sub وفي حدث عند التغيير في مربع النص ضع هذا ::::: If TxtBox.Text = "" Then Exit Sub Call CheckEntryLanguage(Me.TxtBox, Right(TxtBox.Text, 1))

يعني تريد نقل هذه البيانات مجزئة للحقول الظاهرة في النموذج الاخر ... صحيح هذه المطلوب ؟؟

الحمد لله رب العالمين ... بارك الله فيك اخي الكريم منكم نتعلم استاذي الفاضل @Foksh اشكر لك الاطراء

اولا ::: هناك اخطاء لديك لانك استخدمت بعض الكلمات المحجوزة للاكسس ثانيا :::: اقتنصت بعض الاكواد من الخبير @jjafferr فله الشكر والعرفان جرب المرفق ربما هو المطلوب . Change by One Button.accdb