M.Abd Allah

وعليكم السلام ورحمه الله وبركاته 
تقدر تستخدم الطريقه دي هتعمل الداله دي فى module وتحفظها باي اسم 
بالطريقه دى يبقي حضرتك عملت ا
لكود مره واحده وبتستدعيه كل متحب
Public Function HandleKeyDown(KeyCode As Integer, Shift As Integer) As Integer     If KeyCode = 115 Then ' F4         Form_Form1.k1.SetFocus         HandleKeyDown = 0 ' لمنع إدخال بيانات في الحقل الحالي     ElseIf KeyCode = 114 Then ' F3         Form_Form1.k5.SetFocus         HandleKeyDown = 0 ' لمنع إدخال بيانات في الحقل الحالي     Else         HandleKeyDown = KeyCode ' لإعادة KeyCode الأصلي لتمكين إدخال البيانات في الحقل     End If End Function هفترض أن لديك نموذج يحتوى على عده حقول  k1,k2,k3,k4,k5 وعايز تطبق نفس الكود علي جميع هذه الحقول هتعمل فى حدث keydown لكل حقل كالاتى  Private Sub k1_KeyDown(KeyCode As Integer, Shift As Integer)     KeyCode = HandleKeyDown(KeyCode, Shift) End Sub Private Sub k2_KeyDown(KeyCode As Integer, Shift As Integer)     KeyCode = HandleKeyDown(KeyCode, Shift) End Sub Private Sub k3_KeyDown(KeyCode As Integer, Shift As Integer)     KeyCode = HandleKeyDown(KeyCode, Shift) End Sub Private Sub k4_KeyDown(KeyCode As Integer, Shift As Integer)     KeyCode = HandleKeyDown(KeyCode, Shift) End Sub Private Sub k5_KeyDown(KeyCode As Integer, Shift As Integer)     KeyCode = HandleKeyDown(KeyCode, Shift) End Sub    

وعليكم السلام ورحمه الله وبركاته 
طيب تمام جرب الكود ده كده
واهم حاجه تتأكد أن اعدادات الطابعه أنها بتدعم duplex 
 
Private Sub PrintReports_Click()
    Dim reportNumber As String
    Dim prt As Printer
 
    ' افترض أن "رقم التقرير" هو اسم حقل النص في النموذج
    reportNumber = Me!رقم_التقرير
 
    On Error GoTo ErrorHandler
 
    ' تعيين الطابعة للطباعة على الوجهين
    For Each prt In Application.Printers
        If prt.DeviceName = Application.Printer.DeviceName Then
            prt.Duplex = acPRDPVertical ' تعيين الطباعة على الوجهين
            Exit For
        End If
    Next prt
 
    ' فتح التقرير أ باستخدام رقم التقرير كمعيار
    DoCmd.OpenReport "التقرير أ", acViewPreview, , "رقم_التقرير = '" & reportNumber & "'"
    DoCmd.PrintOut , , , , , True ' الطباعة على الوجه الأول
 
    ' إغلاق التقرير أ
    DoCmd.Close acReport, "التقرير أ"
 
    ' فتح التقرير ب باستخدام نفس المعيار
    DoCmd.OpenReport "التقرير ب", acViewPreview, , "رقم_التقرير = '" & reportNumber & "'"
    DoCmd.PrintOut , , , , , False ' الطباعة على الوجه الثاني
 
    ' إغلاق التقرير ب
    DoCmd.Close acReport, "التقرير ب"
 
    Exit Sub
 
ErrorHandler:
    MsgBox "حدث خطأ أثناء الطباعة: " & Err.Description, vbCritical
End Sub

تقدر تضيف اكتر من سنه بنفس الطريقه انا زودت لحضرتك سنتين وتقدر تزود اكتر من سنه بنفس الطريقه 
Private Sub x_AfterUpdate() If x1 <> 0 Then ' لا تفعل شيئًا إذا كانت x1 ليست صفرًا Else Select Case x Case "1446" x1 = Nz(DMax("[m]", "mm", "yy = '1446'") + 1, 4600001) Case "1447" x1 = Nz(DMax("[m]", "mm", "yy = '1447'") + 1, 4700001) Case "1448" x1 = Nz(DMax("[m]", "mm", "yy = '1448'") + 1, 4800001) Case "1449" x1 = Nz(DMax("[m]", "mm", "yy = '1449'") + 1, 4900001) ' يمكنك إضافة حالات أخرى للأعوام الأخرى بنفس الطريقة Case Else MsgBox "السنة غير مدعومة." End Select End If End Sub  

السلام عليكم ورحمه الله وبركاته
هتغير طريقه عرض التقرير للعرض العادى 
بعدها هتعمل زرار فالتقرير مبيظهرش غير فالعرض فقط
وتحط فيه الكود التالى
Dim db As DAO.Database Dim rs As DAO.Recordset Dim sql As String Set db = CurrentDb sql = "SELECT * FROM [كشف مناداه - التقييم المعرفي]" Set rs = db.OpenRecordset(sql, dbOpenDynaset) Do While Not rs.EOF If rs![ملاحظات] = "مؤجل ملف الإنجاز و المهمة" Then rs.Edit rs![ملاحظات] = "يؤدى اختبار الجدارات الأساسية فقط و يؤجل التقييم النهائى للجدارات الفنية لحين استكمال اجتياز وحدات البرنامج" rs.Update ElseIf rs![ملاحظات] = "لا يحق" Then rs.Edit rs![ملاحظات] = "يؤدى اختبار الجدارات الأساسية فقط و لا يحق له التقييم النهائى للجدارات الفنية" rs.Update End If rs.MoveNext Loop rs.Close Set rs = Nothing Set db = Nothing DoCmd.OpenReport "التقييم المعرفي", acViewPreview  
وده المثال اللي تم التعديل عليه 
draz_example.accdb

ولا تزعلى نفسك 
Dim strSQL1 As String Dim db As DAO.Database Dim codeValue As Variant ' التحقق من أن القائمة ليست فارغة If Me.Resultlist.ListCount = 0 Then MsgBox "لا يوجد عناصر للحذف.", vbExclamation Exit Sub End If ' التحقق من أن هناك عنصر محدد If Me.Resultlist.ListIndex = -1 Then MsgBox "يرجى تحديد عنصر من القائمة للحذف.", vbExclamation Exit Sub End If ' الحصول على القيمة المحددة في ListBox codeValue = Me.Resultlist.Value ' التحقق من أن القيمة ليست Null If IsNull(codeValue) Then MsgBox "يرجى تحديد عنصر من القائمة للحذف.", vbExclamation Exit Sub End If ' إنشاء استعلام SQL لحذف السجل strSQL1 = "DELETE FROM fixedresults_tbl WHERE code = " & codeValue & ";" ' فتح قاعدة البيانات وتنفيذ استعلام الحذف Set db = CurrentDb db.Execute strSQL1, dbFailOnError ' إبلاغ المستخدم بالنجاح MsgBox "تم حذف العنصر بنجاح!", vbInformation ' تحديث ListBox لإزالة العنصر المحذوف Me.Resultlist.Requery ' تحديث الحقل غير المنضم في النموذج الرئيسي إذا كان يحتوي على القيمة المحذوفة If Me.code.Value = codeValue Then Me.code.Value = Null End If ' إغلاق الاتصال بقاعدة البيانات Set db = Nothing  

تمام يبقي استخدمي الكود ده 
Private Sub btnAdd_Click() Dim db As DAO.Database Dim rs As DAO.Recordset Dim fixedNameValue As String Dim newResultValue As String Dim sql As String ' الحصول على القيم من الحقول والتحقق من أنها ليست Null If IsNull(Me.Fixedname) Or IsNull(Me.Newresult) Then MsgBox "يرجى ملء جميع الحقول قبل الإضافة.", vbExclamation Exit Sub End If fixedNameValue = Me.Fixedname.Value newResultValue = Me.Newresult.Value ' التحقق من أن القيم ليست فارغة If fixedNameValue = "" Or newResultValue = "" Then MsgBox "يرجى ملء جميع الحقول قبل الإضافة.", vbExclamation Exit Sub End If ' فتح قاعدة البيانات Set db = CurrentDb ' التحقق من عدم وجود قيمة مكررة لنفس Fixedname و Fixedresult sql = "SELECT COUNT(*) AS RecordCount FROM fixedresult_tbl WHERE Fixedname = '" & fixedNameValue & "' AND Fixedresult = '" & newResultValue & "'" Set rs = db.OpenRecordset(sql) If Not rs.EOF And rs!RecordCount > 0 Then MsgBox "القيمة المدخلة موجودة مسبقًا لنفس الاسم الثابت.", vbExclamation rs.Close Set rs = Nothing Set db = Nothing Exit Sub End If rs.Close Set rs = Nothing ' إنشاء تعليمة SQL لإضافة سجل جديد sql = "INSERT INTO fixedresult_tbl (Fixedname, Fixedresult) " & _ "VALUES ('" & fixedNameValue & "', '" & newResultValue & "')" ' تنفيذ تعليمة SQL db.Execute sql, dbFailOnError ' إغلاق قاعدة البيانات Set db = Nothing ' إبلاغ المستخدم بالنجاح MsgBox "تمت الإضافة بنجاح!", vbInformation End Sub  

قدام حضرتك عندك المثال بتاعك ممكن تحطه وإن شاء الله نحاول نعدلك عليه

فى قاعده التحقق من الصحة الحقول اللى عايز تعملها 
اكتب 
Is Not Null
 

تم الغاء الداله حسب فهمي بما ان الحقول المفروض تاخد من الجدول الفاضي تم عمل سجل فالجدول الفاضي للتجربه عليه 

safaa n.accdb

ولا يهمك اتفضل المرفق بعد التعديل
17 june_2.rar

لا ولا يهمك طيب استأذنك افتح الملف ده وشوف التغيرات وجرب كده تعدل اي بيانات للكشوفات
العياده22.mdb
استأذنك جرب كده اللي انت عايزه من خلال نفس القاعده الجديده اللي بعتهالك وقولى رايك

شوف كده المثال اللي عملته ده قصدك عليه 
 
تجزئة الجمله الى مفردات 1.accdb

وعليكم السلام ورحمه الله وبركاته 
اخي جرب الكود ده وقولي النتيجه 
Private Sub Form_MouseWheel(ByVal Page As Boolean, ByVal Count As Long)
    On Error GoTo ErrorHandler
    ' حفظ السجل الحالي قبل التنقل إلى السجل التالي أو السابق
    If Me.Dirty Then
        DoCmd.RunCommand acCmdSaveRecord
    End If
    ' التنقل بين السجلات باستخدام عجلة الماوس
    If (Count < 0) And (Me.CurrentRecord > 1) Then
        DoCmd.GoToRecord , , acPrevious
    ElseIf (Count > 0) And (Me.CurrentRecord < Me.Recordset.RecordCount) Then
        DoCmd.GoToRecord , , acNext
    End If
    Exit Sub
ErrorHandler:
    MsgBox "An error occurred: " & Err.Description, vbCritical
End Sub

مفيش اي تعب الموضوع بسيط تحت امرك 
تعديل التقرير فورم بزرار.accdb