Barna

جرب هذا Function record(Criteria As String) Dim rs As DAO.Recordset Dim db As DAO.Database Dim condition As String ' قم بتعيين قاعدة البيانات الحالية Set db = CurrentDb Set rs = db.OpenRecordset("SELECT * FROM customers") ' تحديد الشرط condition = "City = '" & Criteria & "'" rs.FindFirst condition Do While Not rs.NoMatch ' إضافة العنصر إلى القائمة List1.AddItem rs!FirstName ' ابحث عن العنصر التالي rs.FindNext condition Loop ' إغلاق السجل rs.Close Set rs = Nothing Set db = Nothing End Function Private Sub Command0_Click() Dim City As String ' تعيين القيمة للمدينة City = "aa" ' استدعاء الدالة record City End Sub

هل هذه هي الرسالة الظاهرة لديك ؟؟ اذا كانت الاجابة نعم !!! فانت تحتاج الى تغيير اسم المشروع لديك .... لفعل ذلك انظر الصورة التالية ...... غير اسم Database باي اسم اخر .... فقط

نعم صحيح

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

طيب الحمد لله .... جرب كدة المشكلة السابقة واعلمنا بالنتيجة BAR_A.mdb

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

لم افهم عليك ... لاني اخاطبك بالهاتف

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

طيب لاحظ الشرح التالي ::::::::::::::::::::::::::::: اولا:: الجدول tbl_MenhaRules يجب كتابة اسم المنحة ورقم المنحة ونوع المنحة كما هو موجود بالجداول الموجودة لديك دون تغيير ( اوكد دون تغير لا في الرقم ولا في الاسم ولا في نوع المنحة) كما في الصورة ثانيا:::: المنح التي يكتب في هذا الجدول فقط التى عليها شروط ( 1 تعني سنه - 2 تعني سنتان وهكذا - اما التي تصرف مرة واحدة فسجلها 100 ) ثالثا::: بقية المنح لا تسجل ابدا في هذا الجدول ( يعني في النهاية سوف يون لديك عدد سجلات بسيطة في هذا الجدول الجديد tbl_MenhaRules ) رابعا :::: طبق على المثال المرفق واعلمنا بالنتيجة BAR_A.mdb

هل انت بصدد تعديل شامل على البرنامج ام ماذا؟؟ لاننا لا نريد تعديل الاكواد لكثرتها فقط نريد انشاء جدول واحد جديد فقط اقوم لإنشاء الجدول واعدل في المرفق السابق .... انتظرني

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

حياك الله ..... بسبب التصميم لديك كل نوع منحة في جدول ( المفترض تون بيانات استحقاق المنح كلها في جدول واحد بدل تعدد الجداول ) وبسبب ان برنامجك اعتقد مصمم وتعمل عليه حاليا .... اقترح عليك او فكرت بانشاء جدول صغير تحسبا للتعديلات مثل ممكن في يوم من الايام تريد نعديل منحة معينة بحيث تصبح النظارات الطبية كل سنه مثلا او يصبح الحج كل 10 سنوات او حتى تضيف منح اخرى للشرط .... اقتراحي عمل جدول صغير ونسجل فيه كل المنح المشروطة .... مثلا انظر الصورة ...... 100 تعني مره واحدة في العمر

قد يكون هذا الفانك أقل عدد اسطر من السابق جربة واعلمنا بالنتيجة ................... Public Function CheckInkhirat(ByRef ID As Integer) As String On Error GoTo err_CheckInkhirat Dim yearNow As Integer, totalPaid As Currency, totalPaidLastYear As Currency Dim paymentMarch As Boolean, paymentJuly As Boolean Dim t As Integer, t1 As Integer Dim result_haj As Variant, latestDate As Variant Dim todayDate As Date, yearsDifference As Long ' تحديد السنة If Month(Date) < 3 Then yearNow = Year(Date) - 1 t = 1 Else yearNow = Year(Date) t = 2 End If ' الحصول على تاريخ اليوم todayDate = Date ' إجمالي المبلغ المدفوع totalPaid = Nz(DSum("Payment_Made", "tbl_Loans", "EmployeeID = " & ID & " AND Year(Auto_Date) = " & yearNow & " AND Loan_ID = 0"), 0) ' تحقق من نوع الامتياز Select Case [Forms]![FrmMenah]![Etar] Case "المنح العائلية" result_haj = DLookup("[Menha_Date]", "[Mena7]", "[EmployeeID] =" & ID & " And [Menha_ID] =" & [Forms]![FrmMenah]![Frm_sub].[Form]![CmdMenha] & " And [Menha_ID] =11") Case "التعويضات الطبية" result_haj = Null If [Forms]![FrmMenah]![Frm_sub].[Form]![cmdSanitaire] = 2 Then latestDate = Nz(DMax("[Sanitaire_Date]", "[Sanitaire]", "[EmployeeID] =" & [Forms]![FrmMenah]![EmployeeID] & " And [Nom_Beneficiaire] ='" & [Forms]![FrmMenah]![Frm_sub].[Form]![Nom_Beneficiaire] & "'"), #10/1/2000#) yearsDifference = DateDiff("yyyy", latestDate, todayDate) t1 = IIf(yearsDifference < 2, 1, 2) End If End Select ' التحقق من دفع المبلغ في مارس ويوليو 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 Dim message As String message = "عزيزي المنخرط(ة)، يمكنك الاستفادة من " If t = 1 Then message = message & "الامتيازات لأنك دفعت مبلغ الانخراط الخاص بالسنة الماضية كاملاً." ElseIf t = 2 Then message = message & "جميع الامتيازات لأنك دفعت مبلغ الانخراط كاملاً" If paymentMarch And paymentJuly Then message = message & " على دفعتين." Else message = message & "." End If End If If Not IsNull(result_haj) Then message = message & vbNewLine & "ولكن قد استفت من منحة الحج لعام " & vbNewLine & result_haj ElseIf IsNull(result_haj) And t1 = 1 Then message = message & vbNewLine & "ولكن قد استفت من منحة النظارات الطبية بتاريخ " & vbNewLine & latestDate End If CheckInkhirat = message Else CheckInkhirat = "عزيزي المنخرط(ة)، لا يمكنك الاستفادة من الامتيازات لأنك لم تدفع مبلغ الانخراط." End If Exit Function err_CheckInkhirat: MsgBox "خطأ رقم " & Err.Number & ": " & Err.Description, vbCritical, "خطأ" CheckInkhirat = "حدث خطأ أثناء التحقق من بيانات الانخراط." End Function

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

استخدم هذا الكود بدل الموجود لديك .................. Dim result As String Dim userResponse As VbMsgBoxResult Dim emp As Integer emp = EmployeeID ' استدعاء الدالة للتحقق من الانخراط result = CheckInkhirat(emp) ' عرض النتيجة في رسالة userResponse = MsgBox(result, vbOKOnly + vbInformation, "نتيجة التحقق") ' التحقق من استحقاق الامتياز قبل المتابعة If (result Like "*كاملا*" And Not result Like "*النظارات*") Then ' طلب تأكيد تثبيت المنحة If MsgBox("هل تريد تثبيت تاريخ التعويض الطبي؟", vbYesNo + vbQuestion, "تأكيد") = vbYes Then ' إذا وافق المستخدم، يتم تثبيت التاريخ وإكمال العملية Me.Sanitaire_Date = Date ''Me.Obsérvation = Nom_Moss ''Me.Sanitaire_Value = Me.Montent Else ' إذا رفض المستخدم، يتم التراجع عن أي تغييرات Me.Undo End If Else ' إذا لم يتم استيفاء شروط الانخراط، لا يمكن تثبيت المنحة MsgBox "لا يمكنك تثبيت التعويض الطبي لأن شروط الانخراط غير مستوفاة.", vbExclamation, "تنبيه" Me.Undo End If

الكود الموجود في حدث بعد التحديث انقله في مربع القائمة الأخرى المذكورة ... ايضا تحت حدث بعد التحديث قبل النسخ حول لوحة المفاتيح إلى عربي

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

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

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

ابحث في الفورم الجديد عن ::: Forms!تسجيل الحسابات!اسم العميل وغير عبارة تسجيل الحسابات باسم النموذج الجديد

طيب .... قم بنقل الكود كما في الصورة من مربع القائمة الخاصة بالنوع الى مربع القائمة الخاص بنوعية القرابة ثم انسخ الفانك بدل الفانك الموجود لديك ,,,,,, 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, t2 As Integer Dim result_haj As Variant Dim latestDate As Variant Dim todayDate As Date Dim yearsDifference As Long t1 = 2 ' تحديد السنة If Month(Date) < 3 Then yearNow = Year(Date) - 1 t = 1 Else yearNow = Year(Date) t = 2 End If ' الحصول على تاريخ اليوم todayDate = Date 'إجمالي المبلغ المدفوع totalPaid = Nz(DSum("Payment_Made", "tbl_Loans", "EmployeeID = " & ID & " AND Year(Auto_Date) = " & yearNow & " AND Loan_ID = 0"), 0) If [Forms]![FrmMenah]![Etar] = "المنح العائلية" Then 'التحقق من منحة الحج والنظارات الطبية result_haj = DLookup("[Menha_Date]", "[Mena7]", "[EmployeeID] =" & ID & " And [Menha_ID] =" & [Forms]![FrmMenah]![Frm_sub].[Form]![CmdMenha] & " And [Menha_ID] =11 ") ElseIf [Forms]![FrmMenah]![Etar] = "التعويضات الطبية" And [Forms]![FrmMenah]![Frm_sub].[Form]![cmdSanitaire] = 2 Then If IsNull(DMax("[Sanitaire_Date]", "[Sanitaire]", "[EmployeeID] =" & [Forms]![FrmMenah]![EmployeeID] & " And [Nom_Beneficiaire] ='" & [Forms]![FrmMenah]![Frm_sub].[Form]![Nom_Beneficiaire] & "'")) Then latestDate = #10/1/2000# yearsDifference = DateDiff("yyyy", latestDate, todayDate) Else latestDate = DMax("[Sanitaire_Date]", "[Sanitaire]", "[EmployeeID] =" & [Forms]![FrmMenah]![EmployeeID] & " And [Nom_Beneficiaire] ='" & [Forms]![FrmMenah]![Frm_sub].[Form]![Nom_Beneficiaire] & "'") yearsDifference = DateDiff("yyyy", latestDate, todayDate) End If If yearsDifference < 2 Then result_haj = Null t1 = 1 Else result_haj = Null t1 = 2 End If Else result_haj = Null End If ' التحقق من دفع المبلغ في مارس ويوليو للسنة الحالية 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 t1 = 2 And t = 2 And totalPaid = 3000 And paymentMarch = False And paymentJuly = False And IsNull(result_haj) Then CheckInkhirat = "عزيزي المنخرط(ة)، يمكنك الاستفادة من جميع الامتيازات لأنك دفعت مبلغ الانخراط كاملاً." ElseIf t1 = 2 And t = 2 And totalPaid = 3000 And paymentMarch = True And paymentJuly = True And IsNull(result_haj) Then CheckInkhirat = "عزيزي المنخرط(ة)، يمكنك الاستفادة من جميع الامتيازات لأنك دفعت مبلغ الانخراط كاملاً على دفعتين." ElseIf t1 = 2 And t = 1 And totalPaid = 3000 Then CheckInkhirat = "عزيزي المنخرط(ة)، يمكنك الاستفادة من الامتيازات لأنك دفعت مبلغ الانخراط الخاص بالسنة الماضية كاملاً." 'التحقق من رسائل الحج ElseIf t1 = 2 And t = 1 And totalPaid = 3000 And Not IsNull(result_haj) Then CheckInkhirat = "عزيزي المنخرط(ة)، يمكنك الاستفادة من الامتيازات لأنك دفعت مبلغ الانخراط الخاص بالسنة الماضية كاملاً." & vbNewLine & "ولكن قد استفت من منحة الحج لعام" & vbNewLine & result_haj ElseIf t1 = 2 And t = 2 And totalPaid = 3000 And paymentMarch = False And paymentJuly = False And Not IsNull(result_haj) Then CheckInkhirat = "عزيزي المنخرط(ة)، يمكنك الاستفادة من جميع الامتيازات لأنك دفعت مبلغ الانخراط كاملاً." & vbNewLine & "ولكن قد استفت من منحة الحج لعام" & vbNewLine & result_haj ElseIf t1 = 2 And t = 2 And totalPaid = 3000 And paymentMarch = True And paymentJuly = True And Not IsNull(result_haj) Then CheckInkhirat = "عزيزي المنخرط(ة)، يمكنك الاستفادة من جميع الامتيازات لأنك دفعت مبلغ الانخراط كاملاً على دفعتين." & vbNewLine & "ولكن قد استفت من منحة الحج لعام" & vbNewLine & result_haj 'التحقق من رسائل النظارات الطبية ElseIf t1 = 1 And t = 1 And totalPaid = 3000 And IsNull(result_haj) Then CheckInkhirat = "عزيزي المنخرط(ة)، يمكنك الاستفادة من الامتيازات لأنك دفعت مبلغ الانخراط الخاص بالسنة الماضية كاملاً." & vbNewLine & "ولكن قد استفت من منحةالنظارات الطبية بتاريخ" & vbNewLine & latestDate ElseIf t1 = 1 And t = 2 And totalPaid = 3000 And paymentMarch = False And paymentJuly = False And IsNull(result_haj) Then CheckInkhirat = "عزيزي المنخرط(ة)، يمكنك الاستفادة من جميع الامتيازات لأنك دفعت مبلغ الانخراط كاملاً." & vbNewLine & "ولكن قد استفت من منحةالنظارات الطبية بتاريخ" & vbNewLine & latestDate ElseIf t1 = 1 And t = 2 And totalPaid = 3000 And paymentMarch = True And paymentJuly = True And IsNull(result_haj) Then CheckInkhirat = "عزيزي المنخرط(ة)، يمكنك الاستفادة من جميع الامتيازات لأنك دفعت مبلغ الانخراط كاملاً على دفعتين." & vbNewLine & "ولكن قد استفت من منحةالنظارات الطبية بتاريخ" & vbNewLine & latestDate Else CheckInkhirat = "عزيزي المنخرط(ة)، لا يمكنك الاستفادة من الامتيازات لأنك لم تدفع مبلغ الانخراط." End If Exit Function err_CheckInkhirat: MsgBox "خطأ رقم " & Err.Number & ": " & Err.Description, vbCritical, "خطأ" CheckInkhirat = "حدث خطأ أثناء التحقق من بيانات الانخراط." End Function

هكذا ....................

يعني تريد المستخدم يملأ جميع البيانات وعند الوصول للاسم تخرج له الرسالة ؟؟؟

طيب اذا كنت مصر على طريقتك .... هل هذا هو المطلوب

ولكن لاحظ اخي @كريمو2 ان المستخدم هو من يقوم بكتابة الاسم .... فلو اخطأ في مسافة او حرف الكمبيوتر ذكي لدرجة الغباء ... يعني يقبلها دون تردد .... فلعلاج ذلك المفترض يتم اختيار الاسم من خلال قائمة منسدلة وليس تسجيل المستخدم ,,, اليس كذلك ؟؟؟؟؟؟