نجوم المشاركات

وعليكم السلام ورحمة الله تعالى وبركاته يجب أولا التأكد من عدم تعطيل وحدات الماكرو بسبب أمان الملفات أغلق الملف ثم انقر بزر الماوس الأيمن على خصائص <------ إلغاء الحظر (Unblock) أعد فتح الملف وحاول تشغيل الماكرو التالي Sub OECUE1() Dim WS As Worksheet Dim début As Integer, fin As Integer Set WS = Sheets("haneen") If Not IsNumeric(WS.[H2].Value) Or Not IsNumeric(WS.[U2].Value) Then Exit Sub début = WS.[H2].Value: fin = WS.[U2].Value If début < 1 Or fin < 1 Or début > fin Then Exit Sub If MsgBox("هل ترغب في تنفيذ الطباعة؟", vbYesNo + vbExclamation, "التأكيد") = vbNo Then Exit Sub Application.ScreenUpdating = False Do While début <= fin WS.PrintOut Copies:=1, Collate:=True If début < fin Then WS.[H2].Value = début + 1 début = début + 1 Loop Application.ScreenUpdating = True End Sub الطباعة.rar

وعليكم السلام ورحمة الله تعالى وبركاته جرب هل هدا ما تقصده Option Explicit Sub CopyData() Dim lastRow&, tmp&, i&, Counter& Dim WS As Worksheet, OnRng As Variant Dim SrWS As Worksheet: Set SrWS = Sheets("ملخص") Application.ScreenUpdating = False Application.Calculation = xlCalculationManual SrWS.Range("A5:F" & SrWS.Rows.Count).ClearContents tmp = 5: Counter = 1 For Each WS In ThisWorkbook.Worksheets If WS.Name <> SrWS.Name Then OnRng = WS.Range("A3:E" & WS.Cells(WS.Rows.Count, 1).End(xlUp).Row).Value For i = 1 To UBound(OnRng, 1) If OnRng(i, 1) <> "" Then SrWS.Range("A" & tmp).Value = "فرع " & Counter SrWS.Range("B" & tmp).Resize(1, UBound(OnRng, 2)).Value = Application.Index(OnRng, i, 0) tmp = tmp + 1 End If Next i Counter = Counter + 1 End If Next WS Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic End Sub Book1 V1.xlsb

السلام عليكم يالرغم من عدم وضوح الطلب لعدم اكنمال الجدول افترضت بيانات كما في ورقة2 قائمة الاسماء والتاريخ يتم انشائها بالكود حسب ما هو موجود الملف المصنف1.xlsb

جرب هذا التعديل .. Private Sub cmd_Pay_installments_Click() On Error GoTo err_cmd_Pay_installments_Click ' ..........................الشطر الاول اقتطاع القروض والكهرومنزلية Dim rst As DAO.Recordset 'Cridi and Elec Payments Set rst = CurrentDb.OpenRecordset("Select * From tbl_Loans Where [Payment_Month]=CDATE('" & Me.txtMonth & "')") rst.MoveLast: rst.MoveFirst Rc = rst.RecordCount a1 = 0 'just a flag a2 = 0 'just a flag If Rc = 0 Then MsgBox " لا توجد إقتطاعات لشهر " & Format(Me.txtMonth, "mmmm") & " " & Year(Me.txtMonth), vbInformation Exit Sub End If If Len(rst!Payment_Made & "") = 0 And Not IsNull(rst!Loan_Made) Then Select Case MsgBox("هل تريد أن يتم توزيع الإقتطاعات لشهر " & Me.txtMonth, vbYesNo + vbQuestion + vbDefaultButton1) Case vbYes For i = 1 To Rc rst.Edit If rst!Nr >= 6 Then rst!Payment_Made = 0# Else If rst!Loan_Type = "Cridi" Then rst!Payment_Made = rst!Loan_Made rst!sadad = rst!Loan_Made rst!Loan_Remise = 0 End If If rst!Loan_Type = "Elec" Then rst!Payment_Made = rst!Loan_Made rst!sadad = rst!Loan_Made rst!Loan_Remise = 0 End If End If If rst!sadad.Value = True Then rst!wada3 = "تم التسديد" Else rst!wada3 = "لم يتم التسديد" End If TheSum = TheSum + Nz(rst!Payment_Made, 0) rst.Update rst.MoveNext Next i ' .......................... الشطر الثاني اقتطاع الانخراط 'Other loans for March (3) and July (7) If Month(Now()) = 3 Or Month(Now()) = 7 Then Dim rstE As DAO.Recordset Set rst = CurrentDb.OpenRecordset("Select * From tbl_Loans") myCriteria = "([detach]='موظف'" myCriteria = myCriteria & " Or [detach]='عامل متعاقد توقيت كامل'" myCriteria = myCriteria & " Or [detach]='عامل متعاقد توقيت جزئي'" myCriteria = myCriteria & " Or [detach]='حارس متعاقد توقيت جزئي'" myCriteria = myCriteria & " Or [detach]='عون نظافه وتطهير')" Set rstE = CurrentDb.OpenRecordset("Select * From Employee Where " & myCriteria) rstE.MoveLast: rstE.MoveFirst Rc = rstE.RecordCount For i = 1 To Rc If Month(Now()) = 3 Then If Nz(DLookup("Payment_Made", "tbl_Loans", "EmployeeID=" & rstE!EmployeeID & _ " And [Payment_Made]=3000 And [Payment_Month] Between #1/1/" & Year(Now()) & "# And #2/28/" & Year(Now()) & "#"), 0) = 3000 Then rstE.MoveNext GoTo NextEmployee End If End If If Month(Now()) = 7 Then If Nz(DLookup("Payment_Made", "tbl_Loans", "EmployeeID=" & rstE!EmployeeID & _ " And [Payment_Made]=3000 And [Payment_Month] Between #4/1/" & Year(Now()) & "# And #6/30/" & Year(Now()) & "#"), 0) = 3000 Then rstE.MoveNext GoTo NextEmployee End If End If rst.FindFirst "[Loan_Type]='Inkhirat' And [EmployeeID]=" & rstE!EmployeeID & " And [Payment_Month]=#" & Me.txtMonth & "#" If rst.NoMatch Then rst.AddNew a2 = 1 rst!EmployeeID = rstE!EmployeeID rst!Loan_ID = 0 rst!Payment_Month = DateSerial(Year(Me.txtMonth), Month(Me.txtMonth), 1) rst!Payment_Made = DLookup("Other_Value", "TblOther", "ID=1") rst!Loan_Type = "Inkhirat" rst!Nr = GetNumDetach(rst!EmployeeID) rst!Remarks = "إقتطاع من الراتب لإنخراط شهر " & Year(Me.txtMonth) & "/" & Month(Me.txtMonth) rst!annee = Year(Date) If rst!Loan_Type = "Inkhirat" Then rst!sadad = rst!Payment_Made If rst!sadad.Value = True Then rst!wada3 = "تم الإنخراط" Else rst!wada3 = "لم يتم الإنخراط" End If End If TheSum = TheSum + Nz(rst!Payment_Made, 0) rst.Update NextEmployee: rstE.MoveNext Next i rstE.Close: Set rstE = Nothing End If TheSum = Format(TheSum, "#,##0.00") MsgBox " " & "تم توزيع الإقتطاعات" & vbLf & vbLf & "مجموع الإقتطاعات = " & TheSum, , "إقتطاعات شهر" & FrenchMonth(Month(Date)) & Year(Date) I_am_Done: Case vbNo MsgBox "لم يتم توزيع الإقتطاعات" End Select rst.Close: Set rst = Nothing End If Exit Sub err_cmd_Pay_installments_Click: If Err.Number = 3021 Then Resume Next Else MsgBox Err.Number & vbCrLf & Err.Description End If End Sub

لم تظهر عندي المشاكل التي ذكرتها ,, قمت بالتعديل على قيمة بعد الفلترة وتم الحفظ والخروجمن النموذج دون اي رسائل خطأ !!!!!!!!!

زر الفلترة من المفترض حسب ما فهمت هو باختيار الاسم واللقب . تريد الفلترة بالاسم الأول أو الثاني ؟؟؟؟ ولا كلاهما كشرط للفلترة !!!! جرب هذا التعديل BASER.accdb

شكرا لحضرتك ربنا يجعلو فى ميزان حسناتك

تحية طيبة و شكرا كثيرا أخي الفاضل @Foksh بعد التجربة: زر انهاء الفلترة: يشتغل زر الفلترة: لا يعطي النتيجة المطلوبة وتظهر البيانات فارغة كمافي الصورة المرفقة

هذه تجربة الاخ شايب عدد السجلات المؤشرة بعد تنفيذ الاستعلام 4998 سجل جعفر 1 خارج المقارنة وذلك بسبب الاستاذ خليفة يتم اختيار سجل واحد كل مره كود الاستاذ ابو عارف 1 يختار سجل واحد وايضا كان هناك اشكاليات تمت الاشارة اليها في ثنايا الموضوع كود الاستاذ ابو عارف 2 يستغرق وقت طويل ثم اضطررت الى اغلاق الملف بشكل اجباري كود حبيبنا محمد استغرق ثانية واحدة تقريبا كود جعفر 2 تقريبا نفس الوقت بحدود ثانية تقريبا ماتم ذكره تجربة للتشغيل ولايمكن اعتباره مقارنة مبنية على اساس علمي وربما بعض الاكواد كتبت لمعالجة جزئية محددة لذا فان المقارنة هنا ليست عادلة على الاقل من وجهة نظر الشايب اخيرا تم التشغيل على جهاز قديم متوسط المواصفات معالج i9 الجيل العاشر و128 جيجا رام ونظام تشغيل ويندوز 11 الاصدار 24H2 والله الموفق الشايب

جزاك الله خيرا على ردك الكريم المشكلة ان عملية استخدام الكود فى الطريقة دي تتعارض مع اصدار اكسيل القديم وعمل شهادة ورا التانية تكون صعبة شوية وعلى فكرة عشان مش انسى جهد حضرتك او الاخوة جزاكم الله خيرا انا كنت طلبت الموضوع ده الطباعة وتقريبا حضرتك رديت بطريقة الكود وجزاك الله خير الله المستعان

انت عارف انه المشكلة في الاستعلام الحالي انه بيعتمد على وظائف مخصصة زي funMyCiretria() funMyCiretria1() funMyCiretria2() علشان تعمل تصفية على السجلات ، وبنفس الوقت انت عايز إضافة فلترة إضافية عند الضغط على الزر Cm2 بحيث يتم جلب السجلات التي يتطابق فيها nom_arabe مع tx3 و prenom_arabe مع tx4 !!!!! الحل هنا وباعتقادي انه يجب أولاً تعديل مصدر السجلات النموذج ليصبح الاستعلام كالتالي :- SELECT tbl_note_administrative.classement_liste, tbl_note_administrative.situation_special, tbl_note_administrative.annet, tbl_note_administrative.nom_arabe, tbl_note_administrative.prenom_arabe, tbl_note_administrative.note_adminstative, tbl_note_administrative.note_directeur, tbl_note_administrative.note_fonctionnaire, tbl_note_administrative.situation_poste_travail, tbl_note_administrative.mm FROM tbl_note_administrative WHERE (((tbl_note_administrative.situation_special)=funMyCiretria1()) AND ((tbl_note_administrative.annet)=funMyCiretria()) AND ((tbl_note_administrative.situation_poste_travail)=funMyCiretria2())) OR (((tbl_note_administrative.nom_arabe)=[Forms]![frm_note_administratif]![tx3]) AND ((tbl_note_administrative.prenom_arabe)=[Forms]![frm_note_administratif]![tx4])) ORDER BY tbl_note_administrative.classement_liste; ثانياً في الزر الخاص بالفلترة = الكود التالي :- Private Sub Cm2_Click() Dim filterCondition As String If Not IsNull(Me.tx3) And Not IsNull(Me.tx4) Then filterCondition = "nom_arabe = '" & Me.tx3 & "' AND prenom_arabe = '" & Me.tx4 & "'" Me.Filter = filterCondition Me.FilterOn = True Else Me.FilterOn = False End If End Sub وزر إنهاء الفلترة = الكود التالي :- Private Sub Cm1_Click() Me.tx3 = "" Me.tx4 = "" Me.FilterOn = False Me.Requery End Sub وأما بخصوص الحدث عند التحميل ، فقد تم تعديله بحيث تم استخدام Me.Filter بدلاً من RecordSource Private Sub Form_Load() Dim filterCondition As String filterCondition = "situation_special = '" & funMyCiretria1() & "' " & _ "AND annet = '" & funMyCiretria() & "' " & _ "AND situation_poste_travail = '" & funMyCiretria2() & "'" Me.Filter = filterCondition Me.FilterOn = True Dim WrkSpace As Workspace Set WrkSpace = DBEngine.Workspaces(0) WrkSpace.BeginTrans End Sub هذا من وجهة نظري ، والله أعلم ما لم يكن هناك حل أفضل من أحد الأخوة BASER.accdb

شكرا لحضرتك ربنا يجعل هذا فى ميزان حسناتك اشكرك

بعد التجربة أخي شغال بامتياز هذا هو المطلوب جزاك الله كل خير - جزاك الله كل خير ألف شكر أخي الكريم

المشكلة يا صديقي انه عند اختيار "All Rooms" من الكومبوبوكس cboRoomNumber ، فإن الشرط في جملة WHERE يصبح : WHERE Transactions.RoomNumber = "All Rooms" ولا اعتقد انه عندك غرفة بهذا الاسم أو الرقم ، صحيح ؟؟ لازم تعديل الشرط بحيث إذا كان قيمة الكومبوبوكس cboRoomNumber تساوي "All Rooms" يتم تجاهل شرط رقم الغرفة، أي يتم عرض جميع الغرف بحيث يصبح الاستعلام هكذا :- SELECT Transactions.RoomNumber, [FirstName] & " " & [LastName] AS Name, [DateIn] & " - " & [DateOut] AS [Date], Transactions.Days, Transactions.AmountPaid, Transactions.DateIn, Transactions.DateOut FROM Transactions INNER JOIN Customers ON Transactions.CustomerID = Customers.CustomerID WHERE (([Forms]![frmRPTRoomHistory]![cboRoomNumber] = 'All Rooms') OR (Transactions.RoomNumber = [Forms]![frmRPTRoomHistory]![cboRoomNumber])) AND ((Transactions.DateIn) Between [Forms]![frmRPTRoomHistory]![dtpCheckIn] And [Forms]![frmRPTRoomHistory]![dtpCheckout]); في المرفق التالي ، تم انشاء استعلام جديد وجعله مصدر سجلات التقرير للتجربة .. Microsoft Access قاعدة بيانات جديد ‫(2)‬.accdb

جرب التعديل التالي :- DoCmd.RunSQL "INSERT INTO tbl_note_administrative (num,nom_arabe,prenom_arabe, date_naissance, lieu_naissance, wilaya_naissance, situation_familiale,nombre_enfant,grade_poste_actuel,sifa,grade,date_effet_grade_actuel,loi_fondamontale,situation_poste_travail,classement_liste, annet, nom_poste, situation_special )" & vbCrLf & _ "SELECT tbl_info_fonctionnaire.num, tbl_info_fonctionnaire.nom_arabe, tbl_info_fonctionnaire.prenom_arabe, tbl_info_fonctionnaire.date_naissance, tbl_info_fonctionnaire.lieu_naissance, tbl_info_fonctionnaire.wilaya_naissance, tbl_info_fonctionnaire.situation_familiale,tbl_info_fonctionnaire.nombre_enfant,tbl_info_fonctionnaire.grade_poste_actuel,tbl_info_fonctionnaire.sifa,tbl_info_fonctionnaire.grade,tbl_info_fonctionnaire.date_effet_grade_actuel,tbl_info_fonctionnaire.loi_fondamontale,tbl_info_fonctionnaire.situation_poste_travail,tbl_info_fonctionnaire.classement_liste, [forms]![frm_AddMonth]![annet1] AS Expr4, tbl_poste_superieur.nom_poste, tbl_situation_juridique_mouv.situation_special " & vbCrLf & _ "FROM (tbl_info_fonctionnaire LEFT JOIN tbl_poste_superieur ON tbl_info_fonctionnaire.num = tbl_poste_superieur.code_fonct) " & vbCrLf & _ "INNER JOIN tbl_situation_juridique_mouv ON tbl_info_fonctionnaire.num = tbl_situation_juridique_mouv.code_fonct " & vbCrLf & _ "WHERE tbl_info_fonctionnaire.situation_poste_travail = 'موظف';"

اخوتي @jjafferr @Foksh الجمل الأخيرة كلها تعمل واصبح هذا الموضوع متنوع الثمار .. كل يأخذ حسب حاجته .. اعجبتني آخر جملة الف شكر لجميع من شارك في هذا الموضوع

وعليكم السلام هل هذا ماتريده ؟

ابدا فى وضع التحليل المناسب والتصور الامثل لاحتياجات وابدأ فى انشاء قاعدة البيانات وفقا لذلك ان تعثرت فى تنفيذ اى شئ ارجع الى الموضوع واسال وان شاء الله تجد الدعم المناسب ودعنى اضع لك اللبنة الاولى بشكل عام ولكن قد تكون مخالفة لمتطلباتك او رغباتك او الية العمل لذلك خذ فكرة مما اعرضه عليه فذلك سوف يفتح لك افاق التصور والتخيل الصحيح ليضعك على البداية الصحيحة للمسار الامثل لانشاء قاعدة بياناتك 1. الجداول (Tables) أ. جدول الكتب (Books) الحقول: BookID: مفتاح أساسي (رقمي تلقائي). Title: عنوان الكتاب (نصي). Author: اسم المؤلف (نصي). ISBN: رقم ISBN (نصي، فريد). Publisher: الناشر (نصي). PublicationYear: سنة النشر (تاريخ). GenreID: مفتاح خارجي (يرتبط بجدول التصنيفات). Language: اللغة (نصي). TotalCopies: عدد النسخ الإجمالي (رقمي). AvailableCopies: عدد النسخ المتاحة (رقمي). ShelfLocation: موقع الكتاب على الرف (نصي). ملاحظات إضافية: إذا كان لديك مؤلفون متعددون لنفس الكتاب، يمكن فصل المؤلفين إلى جدول مستقل (Authors) مع جدول وسيط (BookAuthors). إضافة حقل مثل BookDescription لتقديم وصف موجز عن الكتاب قد يكون مفيدًا. ب. جدول الأعضاء (Members) الحقول: MemberID: مفتاح أساسي (رقمي تلقائي). FirstName: الاسم الأول (نصي). LastName: الاسم الأخير (نصي). Email: البريد الإلكتروني (نصي، فريد). Phone: رقم الهاتف (نصي). Address: العنوان (نصي). MembershipDate: تاريخ الانضمام (تاريخ). Status: حالة العضوية (نشيط/غير نشيط، نصي أو منطقي). ملاحظات إضافية: يمكن إضافة حقل MembershipType لتحديد نوع العضوية (مثل عادية أو مميزة). حقل Notes قد يكون مفيدًا لتسجيل أي ملاحظات إضافية. ج. جدول الإعارات (Borrowings) الحقول: BorrowID: مفتاح أساسي (رقمي تلقائي). MemberID: مفتاح خارجي يرتبط بجدول الأعضاء. BookID: مفتاح خارجي يرتبط بجدول الكتب. BorrowDate: تاريخ الإعارة (تاريخ). DueDate: تاريخ الاستحقاق (تاريخ). ReturnDate: تاريخ الإرجاع (تاريخ). Status: حالة الإعارة (معارة/مرجعة/متأخرة). ملاحظات إضافية: يمكن إضافة حقل FineAmount لتسجيل الغرامة عند تأخر الإرجاع. د. جدول التصنيفات (Genres) الحقول: GenreID: مفتاح أساسي (رقمي تلقائي). GenreName: اسم التصنيف (نصي). 2. العلاقات بين الجداول (Relationships) العلاقات: Books.GenreID ↔ Genres.GenreID: علاقة واحد إلى متعدد. Borrowings.MemberID ↔ Members.MemberID: علاقة واحد إلى متعدد. Borrowings.BookID ↔ Books.BookID: علاقة واحد إلى متعدد. ملاحظات: تأكد من تعريف العلاقات في Access وربط الجداول بمفاتيحها الأساسية. قم بتمكين التكامل المرجعي (Referential Integrity) لتجنب إدخال بيانات غير متطابقة. 3. تحسينات إضافية جدول المؤلفين (Authors)اختياري: AuthorID: مفتاح أساسي. AuthorName: اسم المؤلف. ثم إنشاء جدول وسيط BookAuthors: BookID: مفتاح خارجي من جدول الكتب. AuthorID: مفتاح خارجي من جدول المؤلفين. جدول الغرامات (Fines): FineID: مفتاح أساسي. BorrowID: مفتاح خارجي من جدول الإعارات. FineAmount: مبلغ الغرامة. واجهة المستخدم (Forms): إنشاء واجهات سهلة الاستخدام لإضافة الكتب، إدارة الأعضاء، وتتبع الإعارات. إضافة تقارير لإحصائيات المكتبة (مثل الكتب الأكثر استعارة). الاستعلامات (Queries): استعلام لتحديد الكتب المتأخرة عن الإرجاع. استعلام لتقرير الأعضاء النشطين.

إدا كنت قد إستوعبت طلبك بشكل صحيح ربما هدا سيوفي بالغرض Option Explicit Sub CreateDossiers() Dim a As Variant, lastRow As Long, i As Long, msg As String Dim Dossiers As String, Fld As String, Patch As String Dim nCarte As String, nEmploy As String, tyCont As String Dim tbl As Object, Fname As String, fCount As Integer Dim ScrWS As Worksheet: Set ScrWS = Sheets("ورقة1") Set tbl = CreateObject("Scripting.Dictionary") lastRow = ScrWS.Cells(ScrWS.Rows.Count, "B").End(xlUp).Row If lastRow < 2 Then Exit Sub a = ScrWS.Range("B2:D" & lastRow).Value Dossiers = ThisWorkbook.Path & "\" Fld = Dossiers & "عقد ثابت\" Patch = Dossiers & "عقد مؤقت\" If Dir(Dossiers, vbDirectory) = "" Then MkDir Dossiers If Dir(Fld, vbDirectory) = "" Then MkDir Fld If Dir(Patch, vbDirectory) = "" Then MkDir Patch For i = 1 To UBound(a, 1) If Trim(a(i, 3)) = "ثابت" Then tbl(Trim(a(i, 1)) & " - " & Trim(a(i, 2))) = "ثابت" End If Next i fCount = 0 For i = 1 To UBound(a, 1) nCarte = Trim(a(i, 1)): nEmploy = Trim(a(i, 2)): tyCont = Trim(a(i, 3)) If nCarte <> "" And IsNumeric(nCarte) And nEmploy <> "" And tyCont <> "" Then Fname = nCarte & " - " & nEmploy If tbl.Exists(Fname) Then If Dir(Fld & Fname, vbDirectory) = "" Then MkDir Fld & Fname fCount = fCount + 1 End If Else If Dir(Patch & Fname, vbDirectory) = "" Then MkDir Patch & Fname fCount = fCount + 1 End If End If End If Next i msg = IIf(fCount > 0, "تم إنشاء " & fCount & " من المجلدات بنجاح", "جميع المجلدات موجودة مسبقا") MsgBox msg, vbInformation End Sub عقود V2.xlsb

تفضل أخي العزيز .. ولزيادة الخير وضعت لك أكواد جميع الإجراءات الأساسية : الإجراءات الإعتيادية للسجلات ( حفظ - جديد - حذف - إضافة - تكرار - التالي - السابق - الأول - الأخير - .....) '===================================== حفظ السجل والذهاب لسجل جديد Private Sub SaveRecBtn_Click() On Error GoTo Err_SaveRecBtn_Click DoCmd.RunCommand acCmdSaveRecord DoCmd.GoToRecord , , acNewRec Exit_SaveRecBtn_Click: Exit Sub Err_SaveRecBtn_Click: MsgBox Err.Description Resume Exit_SaveRecBtn_Click End Sub '===================================== حذف السجل Private Sub DeleteBtn_Click() On Error GoTo Err_DeleteBtn_Click DoCmd.RunCommand acCmdSelectRecord DoCmd.RunCommand acCmdDeleteRecord Exit_DeleteBtn_Click: Exit Sub Err_DeleteBtn_Click: MsgBox Err.Description Resume Exit_DeleteBtn_Click End Sub '===================================== إضافة سجل جديد Private Sub AddNewBtn_Click() On Error GoTo Err_AddNewBtn_Click DoCmd.GoToRecord , , acNewRec Exit_AddNewBtn_Click: Exit Sub Err_AddNewBtn_Click: MsgBox Err.Description Resume Exit_AddNewBtn_Click End Sub '===================================== السجل التالي Private Sub NextBtn_Click() On Error GoTo Err_NextBtn_Click DoCmd.GoToRecord , , acNext Exit_NextBtn_Click: Exit Sub Err_NextBtn_Click: MsgBox Err.Description Resume Exit_NextBtn_Click End Sub '===================================== السجل السابق Private Sub PreviousBtn_Click() On Error GoTo Err_PreviousBtn_Click DoCmd.GoToRecord , , acPrevious Exit_PreviousBtn_Click: Exit Sub Err_PreviousBtn_Click: MsgBox Err.Description Resume Exit_PreviousBtn_Click End Sub '===================================== السجل الأول Private Sub FirstBtn_Click() On Error GoTo Err_FirstBtn_Click DoCmd.GoToRecord , , acFirst Exit_FirstBtn_Click: Exit Sub Err_FirstBtn_Click: MsgBox Err.Description Resume Exit_FirstBtn_Click End Sub '===================================== السجل الأخير Private Sub LastBtn_Click() On Error GoTo Err_LastBtn_Click DoCmd.GoToRecord , , acLast Exit_LastBtn_Click: Exit Sub Err_LastBtn_Click: MsgBox Err.Description Resume Exit_LastBtn_Click End Sub '===================================== البحث عن سجل Private Sub FinedRecBtn_Click() On Error GoTo Err_FinedRecBtn_Click Screen.PreviousControl.SetFocus DoCmd.RunCommand acCmdFind Exit_FinedRecBtn_Click: Exit Sub Err_FinedRecBtn_Click: MsgBox Err.Description Resume Exit_FinedRecBtn_Click End Sub '===================================== تكرار السجل Private Sub DublicateRecBtn_Click() On Error GoTo Err_DublicateRecBtn_Click DoCmd.RunCommand acCmdSelectRecord DoCmd.RunCommand acCmdCopy DoCmd.RunCommand acCmdRecordsGoToNew DoCmd.RunCommand acCmdSelectRecord DoCmd.RunCommand acCmdPaste Exit_DublicateRecBtn_Click: Exit Sub Err_DublicateRecBtn_Click: MsgBox Err.Description Resume Exit_DublicateRecBtn_Click End Sub '===================================== حفظ السجل Private Sub SaveRecBtn_Click() On Error GoTo Err_SaveRecBtn_Click DoCmd.RunCommand acCmdSaveRecord Exit_SaveRecBtn_Click: Exit Sub Err_SaveRecBtn_Click: MsgBox Err.Description Resume Exit_SaveRecBtn_Click End Sub '===================================== طباعة السجل الحالي Private Sub PrintRecBtn_Click() On Error GoTo Err_PrintRecBtn_Click DoCmd.RunCommand acCmdSelectRecord DoCmd.PrintOut acSelection Exit_PrintRecBtn_Click: Exit Sub Err_PrintRecBtn_Click: MsgBox Err.Description Resume Exit_PrintRecBtn_Click End Sub '===================================== التراجع عن التسجيل Private Sub UndoRecBtn_Click() On Error GoTo Err_UndoRecBtn_Click DoCmd.RunCommand acCmdUndo Exit_UndoRecBtn_Click: Exit Sub Err_UndoRecBtn_Click: MsgBox Err.Description Resume Exit_UndoRecBtn_Click End Sub '===================================== فتح التقرير وطباعة السجل المحدد بدلالة الرقم التسلسلي Private Sub Print_Click() On Error GoTo Err_OpenReportBtn_Click Dim stDocName As String stDocName = "ReportName" DoCmd.OpenReport stDocName, acViewReport, , "ID =" & Me.ID DoCmd.RunCommand acCmdPrintPreview DoCmd.RunCommand acCmdPrint Exit_OpenReportBtn_Click: Exit Sub Err_OpenReportBtn_Click: If Err.Number = 2501 Then Resume Exit_OpenReportBtn_Click 'print cancelled MsgBox Err.Number & vbCr & Err.Description Resume Exit_OpenReportBtn_Click End Sub '===================================== طباعة تقرير Private Sub PrintReportBtn_Click() On Error GoTo Err_PrintReportBtn_Click Dim stDocName As String stDocName = "ReportName" DoCmd.OpenReport stDocName, acNormal Exit_PrintReportBtn_Click: Exit Sub Err_PrintReportBtn_Click: MsgBox Err.Description Resume Exit_PrintReportBtn_Click End Sub '===================================== معاينة تقرير Private Sub VeiwReportBtn_Click() On Error GoTo Err_VeiwReportBtn_Click Dim stDocName As String stDocName = "ReportName" DoCmd.OpenReport stDocName, acPreview Exit_VeiwReportBtn_Click: Exit Sub Err_VeiwReportBtn_Click: MsgBox Err.Description Resume Exit_VeiwReportBtn_Click End Sub '===================================== فتح تقرير Private Sub OpenReportBtn_Click() On Error GoTo Err_OpenReportBtn_Click Dim stDocName As String stDocName = "ReportName" DoCmd.OpenReport stDocName, acViewReport Exit_OpenReportBtn_Click: Exit Sub Err_OpenReportBtn_Click: MsgBox Err.Description Resume Exit_OpenReportBtn_Click End Sub '===================================== حفظ تقرير بصيغة Private Sub SendReportToBtn_Click() On Error GoTo Err_SendReportToBtn_Click Dim stDocName As String stDocName = "ReportName" DoCmd.OutputTo acReport, stDocName Exit_SendReportToBtn_Click: Exit Sub Err_SendReportToBtn_Click: MsgBox Err.Description Resume Exit_SendReportToBtn_Click End Sub

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

شكرا لحضرتك عند تجربه يوجد خطأ لا يفتح التقرير قاعدة بيانات جديد ‫(2)‬.rar

ممتاز ممكن الملف