Foksh

وعليكم السلام ورحمة الله وبركاته ,,
جرب هذا التعديل !!
Sub imad() Dim doc As Document Dim db As Object Dim rs As Object Dim f As FileDialog Set doc = ActiveDocument Set db = CreateObject("DAO.DBEngine.120").OpenDatabase(ActiveDocument.Path & "\10 - TMLEK.mdb") Set rs = db.OpenRecordset("qtsder") Application.ScreenUpdating = False While Not rs.EOF With doc.Content.Find .ClearFormatting .Text = rs.Fields(0).Value .Replacement.ClearFormatting .Replacement.Text = rs.Fields(1).Value .Execute Replace:=wdReplaceAll, _ Format:=True, _ MatchCase:=True, _ MatchWholeWord:=True, _ Wrap:=wdFindContinue End With rs.MoveNext Wend rs.Close db.Close Set rs = Nothing Set db = Nothing Application.ScreenUpdating = True MsgBox "تم الانتهاء من الاستبدال بنجاح", vbInformation + vbMsgBoxRight, "" End Sub افتح الملف المرفق على اصدار 2016 ،واخبرنا بالنتيجة
 
مجلد جديد (2).zip

أخي أسعد ،
وعليكم السلام ورحمة الله وبركاته ،،
 
أولاً تقبل الله طاعاتنا وطاعاتكم ، وكل عام وأنتم بخير . دائماً ما ننوه ونذكر حريصين على مساعدتكم بضرورة تحديد تفاصيل المشكلة وإرفاق ملف حتى وإن تكرر نفس الملف في مشاركات ومواضيع ومشاكل سابقة . كما أُشير إليك بذكر سبب استفسارك عن صحة الدالة ( المشكلة التي تواجهها ) .
 
بما انك استخدمت First في استعلامك ، فأعتقد وأنه من الأفضل لك استخدام الترتيب في نتائج الاستعلام ORDER BY .
قد نسيت بنية الاستعلامات السابقة في مشاريعك . لذا حاول استخدام الفرز حسب قيمة معينة ليتم جلب أول قيمة لك من نتيجة الإستعلام .

وعليكم السلام ورحمة الله وبركاته ،
في البداية أعتقد أن الفكرة قد تكون متشعبة نوعاً ما ، بالإعتماد على النتائج التي قد تحتلف في كل مرة يتم فيها النقر على زر "توزيع الملاحظين" . لذا بعد تجربتك لهذه الفكرة البسيطة ، أخبرنا بالنتيجة وبالتفصيل . مع العلم أنه يوجد لديك فكرتين ، ومن خلال تجربتك ومتابعتك للنتائج ، اخبرنا بتفاصيل النتائج التي عادت لك .
شرح الفكرة الأولى التي تمت :-
السرعة في التوزيع ، حيث يعمل الكود بشكل أسرع بكثير لأنه :- يستخدم مصفوفات للتعامل مع البيانات بدلاً من الخلايا مباشرة . يعطل التحديث التلقائي وإعادة الحساب أثناء التنفيذ . ضمان عدم تكرار الملاحظ في نفس اللجنة :- يستخدم خوارزمية توزيع دائرية تضمن عدم التكرار في اللجنة الواحدة . التوزيع العادل :- يحاول توزيع الملاحظين على اللجان بالتساوي قدر الإمكان . يمر كل ملاحظ على جميع اللجان خلال فترات الامتحانات .  
الكود الذي تم استخدامه لهذه الفكرة ( مع دالة بسيطة مساعدة ) :- Sub DistributeObservers() Application.ScreenUpdating = False Application.Calculation = xlCalculationManual On Error GoTo ErrorHandler Dim ws As Worksheet Set ws = ThisWorkbook.Worksheets("الثانوية العامة") Dim observers As Range, committees As Range Dim observerCount As Long, committeeCount As Long Dim distributionRange As Range Dim i As Long, j As Long, attempts As Long Dim observerList() As Variant, committeeList() As Variant Dim distributionArray() As Variant Dim observerUsage() As Long Set observers = ws.Range("B3:B" & ws.Cells(ws.Rows.Count, "B").End(xlUp).row) observerCount = observers.Count observerList = observers.Value committeeCount = 30 ReDim committeeList(1 To committeeCount) For i = 1 To committeeCount committeeList(i) = "لجنة " & i Next i Set distributionRange = ws.Range("D3").Resize(observerCount, committeeCount) ReDim distributionArray(1 To observerCount, 1 To committeeCount) ReDim observerUsage(1 To observerCount) Dim randomizedObservers() As Variant randomizedObservers = ShuffleArray(observerList) For j = 1 To committeeCount For i = 1 To observerCount distributionArray(i, j) = randomizedObservers((i + j - 2) Mod observerCount + 1, 1) observerUsage((i + j - 2) Mod observerCount + 1) = observerUsage((i + j - 2) Mod observerCount + 1) + 1 Next i Next j distributionRange.Value = distributionArray For i = 1 To observerCount ws.Cells(i + 2, 1).Value = Application.CountIf(distributionRange, observerList(i, 1)) Next i Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic MsgBox "تم التوزيع بنجاح!", vbInformation + vbMsgBoxRight, "" Exit Sub ErrorHandler: Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic MsgBox "حدث خطأ: " & Err.Description, vbCritical + vbMsgBoxRight, "" End Sub Function ShuffleArray(arr As Variant) As Variant Dim i As Long, j As Long Dim temp As Variant For i = UBound(arr) To LBound(arr) + 1 Step -1 j = Int((i - LBound(arr) + 1) * Rnd + LBound(arr)) temp = arr(i, 1) arr(i, 1) = arr(j, 1) arr(j, 1) = temp Next i ShuffleArray = arr End Function  
 
شرح الفكرة الثانية التي تمت :-
بالذهاب الى التخلص من الدوال المساعدة ، أو تقييد الفكرة السابقة ، حيث تم استنباط فكرة أخرى تعمل على :-
استخدام خوارزمية توزيع دائرية مباشرة بدون حاجة لفكرة خلط المصفوفات التي قد تكون ذات نتائج مختلفة في كل مرة عند التوزيع . ( وهي الفكرة التي خطرت ببالي سابقاً ) . الإعتماد على احتساب التكرارات أثناء التوزيع نفسه . معالجة البيانات كمصفوفات بدلاً من نطاقات خلايا !!!!!
 
تقليل الوصول إلى ورقة العمل ، مما يساعد على الوصول الى نتيجة أسرع .
 
اعتماد فكرة رسائل أكثر وصفية و تحتوي على أرقام الملاحظين واللجان .
 
 
 
الكود الذي تم استخدامه لهذه الفكرة :-
Sub DistributeObservers() On Error GoTo ErrorHandler Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("الثانوية العامة") Dim observers As Variant: observers = ws.Range("B3", ws.Cells(ws.Rows.Count, "B").End(xlUp)).Value Dim observerCount As Long: observerCount = UBound(observers) Dim committeeCount As Long: committeeCount = 30 ws.Range("A3:A" & observerCount + 2).ClearContents ws.Range("D3").Resize(observerCount, committeeCount).ClearContents Dim i As Long, j As Long For j = 1 To committeeCount For i = 1 To observerCount ws.Cells(i + 2, j + 3).Value = observers((i + j - 2) Mod observerCount + 1, 1) Next i Next j For i = 1 To observerCount ws.Cells(i + 2, 1).Value = Application.CountIf(ws.Range("D3").Resize(observerCount, committeeCount), observers(i, 1)) Next i MsgBox "تم توزيع " & observerCount & " ملاحظاً على " & committeeCount & " لجنة بنجاح", vbInformation + vbMsgBoxRight, "إنجاز" ErrorHandler: Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic If Err.Number <> 0 Then MsgBox "خطأ " & Err.Number & ": " & Err.Description, vbCritical, "خطأ" End Sub  
وطبعاً في كلا الحالتين ، تم اضافة دالة ماكرو بسيطة لمسح القيم وتنظيف الجدول من التوزيعات :-
Sub ClearDistribution() Application.ScreenUpdating = False On Error Resume Next Dim ws As Worksheet Set ws = ThisWorkbook.Worksheets("الثانوية العامة") Dim lastRow As Long lastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).row ws.Range("D3:AH" & lastRow).ClearContents ws.Range("A3:A" & lastRow).ClearContents Application.ScreenUpdating = True MsgBox "تم مسح بيانات التوزيع بنجاح", vbInformation + vbMsgBoxRight, "" End Sub
 
الملفين للفكرتين :-
ملاحظة_ث.ع - 1.xlsm ملاحظة_ث.ع - 2.xlsm

وعليكم السلام ورحمة الله وبركاته ..
استعملت استعلام تحديث بعد اضافة الحقل النصي LinkTxt في الجدول ، فيقوم بتحديث قيمة الحقل لكل سجل باستخراج اسم الموقع على شكل نص وليس رابط تشعبي .
UPDATE Linktbl SET Linktbl.LinkTxt = HyperlinkPart([LinkName], 1) WHERE Linktbl.LinkName IS NOT NULL;  
LinkName.accdb

بسيطة ان شاء الله اخي الكريم ، جرب هذا التعديل ، حيث تم استخدام الكود التالي للتحقق والاضافة عندم عدم وجود العام الدراسي الحالي .
Private Sub MeetingDate_AfterUpdate() Dim academicYear As String Dim rs As DAO.Recordset Dim response As VbMsgBoxResult Dim prevDate As Variant On Error GoTo ErrHandler academicYear = IIf(Month(Me.MeetingDate) >= 9, _ Year(Me.MeetingDate) & "-" & (Year(Me.MeetingDate) + 1), _ (Year(Me.MeetingDate) - 1) & "-" & Year(Me.MeetingDate)) Set rs = CurrentDb.OpenRecordset("SELECT Academic_Name FROM AcademicYearTble WHERE Academic_Name = '" & academicYear & "'", dbOpenSnapshot) If rs.EOF Then response = MsgBox("العام الدراسي """ & academicYear & """ غير موجود." & vbCrLf & "هل تريد إضافته؟", vbQuestion + vbYesNo + vbMsgBoxRight, "إضافة عام دراسي") If response = vbYes Then CurrentDb.Execute "INSERT INTO AcademicYearTble (Academic_Name) VALUES ('" & academicYear & "')", dbFailOnError Me.Academic_Name = academicYear Else MsgBox "تم إلغاء التحديث.", vbExclamation Me.Undo End If Else Me.Academic_Name = academicYear End If rs.Close Set rs = Nothing Exit Sub ErrHandler: MsgBox "حدث خطأ: " & Err.Description, vbCritical + vbMsgBoxRight, "" On Error Resume Next rs.Close Set rs = Nothing End Sub  
الملف بعد التعديل
AcademicYear2.accdb

وعليكم السلام ورحمة الله وبركاته ،،
أتمنى أن تكون الصورة قد وضحت لي وتم فهمها بالشكل الصحيح 😅 ..
انظر للصورة الأولى :-

والنتيجة للصورة الثانية :-

 
 هل تلبي المطلوب بالشكل الصحيح  ؟
خبرتي في اكسل قليلة جداً مقارنة مع الأساتذة ( دون استثناء ) في هذا الصرح الكبير  .
 
التنفيذ تم باستخدام الماكرو التالي :-
Sub FillAccountNum() Dim ws As Worksheet Dim lastRow As Long Dim i As Long, j As Long Dim accountVal As String Set ws = ActiveSheet lastRow = ws.Cells(ws.Rows.Count, "K").End(xlUp).Row For i = 2 To lastRow If InStr(1, ws.Cells(i, "K").Value, "متبقي تعاقد مشروع قسط") > 0 Then For j = i + 1 To lastRow If Trim(ws.Cells(j, "A").Value) Like "Account*" Then accountVal = ws.Cells(j, "A").Value ws.Cells(i, "A").Value = accountVal Exit For End If Next j End If Next i End Sub  
المرفق بعد التنفيذ :-
EXPORT.xlsm
 
وفيما يلي ، توضيح لتفعيل وضع المطور واختيار الماكرو للشيت الحالي ..

 
جرب وأخبرني بالنتيجة ، للمتابعة  .

وعليكم السلام ورحمة الله وبركاته ..
احذف بيانات الجدول ( Tbl_degree_Detail ) أولاً ، ثم عدل الاستعلام في زر الاعداد الى التالي :-
DoCmd.RunSQL "INSERT INTO Tbl_degree_Detail ( draseid, draseDate, Stu_card, Elsaf, madaNum, madaName, ramz, ramz2, Stugalos ) " & vbCrLf & _ "SELECT [forms]![frm_DraseIN]![drase] AS drs, [forms]![frm_DraseIN]![Text1] AS drsdt, Tbl_student.Stucard, Tbl_student.alsaf_Id, Tbl_materil.materil_id, Tbl_materil.materil, Tbl_materil_Detail.rmz, Tbl_materil_Detail.rmz2, Tbl_student.Stugalos " & vbCrLf & _ "FROM Tbl_materil INNER JOIN ((Tbl_saf INNER JOIN Tbl_student ON Tbl_saf.saf_id = Tbl_student.alsaf_Id) INNER JOIN Tbl_materil_Detail ON Tbl_saf.saf_id = Tbl_materil_Detail.saf_No) ON Tbl_materil.materil_id = Tbl_materil_Detail.mat_NO;" طبعاً وللتأكيد بإخبارك بضرورة إضافة نفس الحقل من نفس النوع في الحدول المستهدف ، واعتقدت بعدم ذكرها أنك تعلم ذلك 
جرب وأخبرني بالنتيجة .. 😅

نعم فهمتك على ما أعتقد ، انت تريد زر الطباعة أن يعمل على أي تقرير تم فتحه ( في الوقت الحالي ) ، صحيح ؟؟
سنحاول الإستفادة من المتغير العام :-
Public namerpts As String
بحيث نمرر لزر التصدير اسم التقرير الحالي بشكل ديناميكي . وعليه فيصبح الكود لزر التصدير كالتالي :-
Dim stDocName As String, xx As String, strPathAndfile As String Dim reportDate As Variant stDocName = namerpts On Error Resume Next reportDate = [Reports]![namerpts]![DATE] On Error GoTo 0 If IsNull(reportDate) Or Not IsDate(reportDate) Then xx = stDocName & "-" & Format(DATE, "dd_mm_yyyy") Else xx = stDocName & "-" & Format(reportDate, "dd_mm_yyyy") End If strPathAndfile = CurrentProject.Path & "\" DoCmd.OutputTo acOutputReport, stDocName, acFormatPDF, strPathAndfile & xx & ".pdf", True  
لم أقم بتصعيد الموضوع بكود طويل ، واقتصرت على الكود السابق لسهولته وفهمه بسهولة ,, تفضل الملف بعد التعديل ، جربه وأخبرني بالنتيجة .
ملاحظة ..
يفضل أن يكون اسم الحقل الخاص بالتاريخ متساوي في كل التقارير ، لتلافي تطوير الكود  .
 
 
حفظ بصغة PDF.zip

وعليكم السلام ورحمة الله وبركاته ,,
بعد فهم الموضوع ، هذه محاولتي البسيطة ، حيث بعد انشاء النموذج والتقرير ، وإضافة عنصر CheckBox جنب كل حقل ترغب بلإظهاره أو لا ، ومن خلال الزر في النموذج اعتمدت على TempVars لحفظ قيمة كل CheckBox ثم فتح التقرير من خلال الكود التالي في الزر :-
Private Sub btn_PreviewReport_Click() TempVars("SelectedEmpCode") = Me.Tx_Emp.Column(0) TempVars("Show_NationalID") = Me.chk_NationalID.Value TempVars("Show_Emp_BirthDate") = Me.chk_Emp_BirthDate.Value TempVars("Show_Emp_Phone") = Me.chk_Emp_Phone.Value TempVars("Show_Qualification") = Me.chk_Qualification.Value TempVars("Show_Graduation") = Me.chk_Graduation.Value TempVars("Show_Emp_Address") = Me.chk_Emp_Address.Value TempVars("Show_Appointment") = Me.chk_Appointment.Value TempVars("Show_InsuranceID") = Me.chk_InsuranceID.Value TempVars("Show_JobDesc") = Me.chk_JobDesc.Value TempVars("Show_Department") = Me.chk_Department.Value TempVars("Show_Salary") = Me.chk_Salary.Value TempVars("Show_InsuranceFee") = Me.chk_InsuranceFee.Value DoCmd.OpenReport "Rpt_EmployeeStatement", acViewPreview End Sub  
الآن وفي التقرير ، استخدمت الـ Tag لتحديد ارتفاع العناصر جميعها بحيث تم تحديده 400 ، ومن هنا تم الاعتماد على الدالة :-
Private Sub AdjustFieldVisibility(ctrl As Control, showField As Boolean) If showField Then ctrl.Height = Val(ctrl.Tag) ctrl.Visible = True Else ctrl.Visible = False ctrl.Height = 0 End If End Sub بإخفاء وتصغير ارتفاع العناصر التي لا نرغب بها ..
وفي مصدر سجلات  التقرير ، استخدم الاستعلام التالي :-
SELECT * FROM tbl_Employees WHERE (((tbl_Employees.[Emp_Code])=[TempVars]![SelectedEmpCode])); وفي الحدث عند التنسيق ، استخدمت الكود التالي لاستدعاء الدالة السابقة وتطبيق الاخفاء على العناصر التي لا نريدها .
Private Sub Detail_Format(Cancel As Integer, FormatCount As Integer) AdjustFieldVisibility Me.NationalID, TempVars!Show_NationalID AdjustFieldVisibility Me.Emp_BirthDate, TempVars!Show_Emp_BirthDate AdjustFieldVisibility Me.Emp_Phone, TempVars!Show_Emp_Phone AdjustFieldVisibility Me.Qualification, TempVars!Show_Qualification AdjustFieldVisibility Me.Graduation, TempVars!Show_Graduation AdjustFieldVisibility Me.Emp_Address, TempVars!Show_Emp_Address AdjustFieldVisibility Me.Appointment, TempVars!Show_Appointment AdjustFieldVisibility Me.InsuranceID, TempVars!Show_InsuranceID AdjustFieldVisibility Me.JobDesc, TempVars!Show_JobDesc AdjustFieldVisibility Me.Department, TempVars!Show_Department AdjustFieldVisibility Me.Salary, TempVars!Show_Salary AdjustFieldVisibility Me.InsuranceFee, TempVars!Show_InsuranceFee End Sub طبعاً طرق كثيرة قد تحقق لك المطلوب ، ولكن هذه رؤيتي  
وفي النهاية ، الملف بعد التعديل :-
 
 
بيان حاله.accdb

وعليكم السلام ورحمة الله تعالى وبركاته..
الق نظرة على هذا الموضوع 
 
 

في الملف الذي ارسلته لك ؟؟؟؟

وعليكم السلام ورحمة الله وبركاته ،،

جرب هذا التعديل على حسب ما فهمت من الشرح  
 
Sub Test_Optimized() Dim ws As Worksheet, dataArr As Variant, outputArr() As Variant Dim i As Long, ii As Long, p As Long, startRow As Long, endRow As Long Dim chunkSize As Long, chunkStart As Long, chunkEnd As Long Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Application.EnableEvents = False Set ws = ActiveSheet chunkSize = 5000 ReDim outputArr(1 To chunkSize * 10, 1 To 14) With ws .Columns("Q:P").Clear .Columns("P").ColumnWidth = 12 .Range("R1").Resize(, 14).Value = Array("الدفعة", "ج", "ت ح", "ت م", "ت ع", "ل ع", "ل ح", "ل م", "ل ع1", "ر ع1", "ل ح1", "ر ح1", "ل م", "ر م1") .Range("R1").Resize(, 14).Interior.Color = RGB(146, 205, 220) .Range("R1").Resize(, 14).HorizontalAlignment = xlCenter For chunkStart = 2 To 13000 Step chunkSize chunkEnd = chunkStart + chunkSize - 1 If chunkEnd > 13000 Then chunkEnd = 13000 dataArr = .Range("A" & chunkStart & ":N" & chunkEnd).Value p = 1 For i = LBound(dataArr, 1) To UBound(dataArr, 1) If IsNumeric(dataArr(i, 2)) And IsNumeric(dataArr(i, 3)) Then startRow = dataArr(i, 2) endRow = dataArr(i, 3) For ii = startRow To endRow outputArr(p, 1) = dataArr(i, 1) outputArr(p, 2) = ii outputArr(p, 3) = dataArr(i, 4) outputArr(p, 4) = dataArr(i, 5) outputArr(p, 5) = dataArr(i, 6) outputArr(p, 6) = dataArr(i, 7) outputArr(p, 7) = dataArr(i, 8) outputArr(p, 8) = dataArr(i, 9) outputArr(p, 9) = dataArr(i, 10) outputArr(p, 10) = dataArr(i, 11) outputArr(p, 11) = dataArr(i, 12) outputArr(p, 12) = dataArr(i, 13) outputArr(p, 13) = dataArr(i, 14) outputArr(p, 14) = dataArr(i, 14) p = p + 1 Next ii End If Next i If p > 1 Then .Range("R" & chunkStart).Resize(p - 1, 14).Value = outputArr ReDim outputArr(1 To chunkSize * 10, 1 To 14) End If Next chunkStart End With Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic Application.EnableEvents = True End Sub  

أخي جو الخطأ منك ، حيث في استعلامك يتم تحديث حقل مختلف في جدول مختلف عن الحقل الموجود في الاستعلام مصدر النموذج الفرعي
انظر التعديل الصحيح :-
DoCmd.RunSQL "UPDATE Tbl_Lab_All SET External_lab = 'المختبر' " & _ "WHERE PCode = [ID];"  
وقم بإيقاف السطر
 
Me.External_lab = "المختبر"  

وعليكم السلام ورحمة الله وبركاته ،،
أخي الكريم قبل البدء بطرح الحلول ، هل يوجد اي شروط للسجل الذي تريد حذف أول 3 أرقام منه كما ذكرت ، أم سيكون على جميع السجلات في الحقل EmpID داخل الجدول T1 ؟؟
اذا كان بدون شروط ، فهنا أنت تحتاج لاستعلام تحديث بسيط كالتالي :-
UPDATE T1 SET EmpID = Left(EmpID, Len(EmpID) - 3) WHERE Len(EmpID) > 3;  
في مثالك بعد التعديل ، شوف السجلات قبل تشغيل الاستعلام Query1 وبعد تشغيله إن كانت النتيجة سليمة ..
 
DDFinding Differences-Last.mdb

تفرق ايه ؟؟؟
الإستدعاء واحد من هنا أو من هناك ..
على العموم انا خارج المنزل وبعيد عن الكمبيوتر ، بأقرب فرصة نتابع 😇 

كما تريد أخي @سامر محمود ،،
تفضل هذا التعديل :-
 
 
Pepsi-fockh.zip

استبدل الإستعلام السابق ، بالاستعلام التالي :-
PARAMETERS [Forms]![Frm_Bons]![cmpagen] Long, [Forms]![Frm_Bons]![cmpkind] Text ( 255 ), [Forms]![Frm_Bons]![fromdate] DateTime, [Forms]![Frm_Bons]![todate] DateTime, [Forms]![Frm_Bons]![cmb_prod] Text ( 255 ); SELECT tbl_Bons.Bon_nu, tbl_Bons.BonDate, tbl_Bons.Bon_kind, tbl_Bons.agent_id, tbl_Bons.carNo, tbl_Bons.driver_nm, tbl_Bons.Prod_no, tbl_Bons.Qty, tbl_Bons.sale_price, tbl_Bons.Remark, [sale_price] * [Qty] AS txtall FROM tbl_Bons WHERE (tbl_Bons.agent_id=Forms!frm_Bons!cmpagen Or Forms!Frm_Bons!cmpagen Is Null) And (tbl_Bons.Bon_kind Like "*" & Forms!Frm_Bons!cmpkind & "*" Or Forms!Frm_Bons!cmpkind Is Null) And ((tbl_Bons.BonDate>=Forms!Frm_Bons!fromdate Or Forms!Frm_Bons!fromdate Is Null) And (tbl_Bons.BonDate<=Forms!Frm_Bons!todate Or Forms!Frm_Bons!todate Is Null)) And (tbl_Bons.Prod_no Like "*" & Forms!Frm_Bons!cmb_prod & "*" Or Forms!Frm_Bons!cmb_prod Is Null); تطبيق الفلترة على 4 مراحل كما تريد ، ومن رأيي الإستعلام أفضل لك للتعامل مع الفلترة المتعددة  

أخي طاهر ، الواضح من خلال الكود انك تعتمد على مربع النص IDM كشرط للحصول على رقم الهامش للزوجة ، ولكن!!
مربع النص IDM عند الكود التالي :-
If SearchListZ.ListIndex = -1 Then Me.IDM = SearchListZ.Column(0, 1) Else: Me.IDM = SearchListZ.Column(0) Cr = DLookup("Hamech", "Tbl_ZAWJA", "IDM =" & Me.IDM) If Cr = 4 Then MsgBox " تنبيه ! هذه الزوجة متوفيه" DoCmd.Close acForm, "A1" تكون قيمته = تاريخ ميلاد الزوجة ، وهنا لا تتم المقارنة بالشرط بشكل صحيح .
لذا ، انشئ مربع نص جديد على سبيل المثال Tx_IDM ، واجعل قيمته = رقم الزوجة
Me.Tx_IDM = [Forms]![Search_Frm]![IDM] ثم عدل الجزء السابق ليصبح :-
If SearchListZ.ListIndex = -1 Then Me.IDM = SearchListZ.Column(0, 1) Else: Me.IDM = SearchListZ.Column(0) Cr = DLookup("Hamech", "Tbl_ZAWJA", "IDM =" & Me.Tx_IDM) If Cr = 4 Then MsgBox " تنبيه ! هذه الزوجة متوفيه" DoCmd.Close acForm, "A1" وعليه سيظهر لك مسج انه هذه الزوجة متوفية ، ونفس الشيء عند الزوج في مربع النص IDP ، هو شرط لجلب قيمة الهامش ، ولكن قيمته = تاريخ ميلاد الزوج
 
قمت بذكر المشكلة وتركت الحل لك لتتبين لك الأمور بشكل واضح .

أخي طاهر ، الواضح من خلال الكود انك تعتمد على مربع النص IDM كشرط للحصول على رقم الهامش للزوجة ، ولكن!!
مربع النص IDM عند الكود التالي :-
If SearchListZ.ListIndex = -1 Then Me.IDM = SearchListZ.Column(0, 1) Else: Me.IDM = SearchListZ.Column(0) Cr = DLookup("Hamech", "Tbl_ZAWJA", "IDM =" & Me.IDM) If Cr = 4 Then MsgBox " تنبيه ! هذه الزوجة متوفيه" DoCmd.Close acForm, "A1" تكون قيمته = تاريخ ميلاد الزوجة ، وهنا لا تتم المقارنة بالشرط بشكل صحيح .
لذا ، انشئ مربع نص جديد على سبيل المثال Tx_IDM ، واجعل قيمته = رقم الزوجة
Me.Tx_IDM = [Forms]![Search_Frm]![IDM] ثم عدل الجزء السابق ليصبح :-
If SearchListZ.ListIndex = -1 Then Me.IDM = SearchListZ.Column(0, 1) Else: Me.IDM = SearchListZ.Column(0) Cr = DLookup("Hamech", "Tbl_ZAWJA", "IDM =" & Me.Tx_IDM) If Cr = 4 Then MsgBox " تنبيه ! هذه الزوجة متوفيه" DoCmd.Close acForm, "A1" وعليه سيظهر لك مسج انه هذه الزوجة متوفية ، ونفس الشيء عند الزوج في مربع النص IDP ، هو شرط لجلب قيمة الهامش ، ولكن قيمته = تاريخ ميلاد الزوج
 
قمت بذكر المشكلة وتركت الحل لك لتتبين لك الأمور بشكل واضح .

صورة توضيحية ..

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

هل هذا ما تريده ؟
 
class_be1.accdb

وعليكم السلام ورحمة الله وبركاته ..
المطلوب غير مفهوم للأسف !!
نرجو منك التوضيح أكثر أخي الفاضل

بعد إذن معلمي الفاضل @ابوخليل ، قمت بدمج الإستعلامين كما فعلت في السابق ، مع إضافة شرطين ( الفصل والصف ) .
أخي @2saad انشئ استعلام جديد وألصق الكود التالي :-
PARAMETERS [Forms]![frm_Reports]![ComboSaf] Short, [Forms]![frm_Reports]![termNum] Short; TRANSFORM IIf([Forms]![frm_Reports]![termNum]=1,First(qry_master.mgmo1),First(qry_master.mgmo2)) AS FirstOfmgmo SELECT qry_master.alsaf_Id, qry_master.draseDate, qry_master.Stucard, qry_master.Studentname, qry_master.fsl_id, qry_master.Stugalos, qry_master.StuSery, qry_master.gender, qry_Temp.vHodor, qry_Temp.alnesbah, qry_Temp.tgyeem1, qry_Temp.hala FROM qry_master LEFT JOIN qry_Temp ON qry_master.Stucard = qry_Temp.Stucard WHERE (((qry_master.alsaf_Id)=[Forms]![frm_Reports]![ComboSaf])) GROUP BY qry_master.alsaf_Id, qry_master.draseDate, qry_master.Stucard, qry_master.Studentname, qry_master.fsl_id, qry_master.Stugalos, qry_master.StuSery, qry_master.gender, qry_Temp.vHodor, qry_Temp.alnesbah, qry_Temp.tgyeem1, qry_Temp.hala PIVOT qry_master.madaNum In (1,2,3,4,5,6,7,8,9,10,11,12,13,14); واجعله مصدر سجلات التقرير السابق نفسه ، وجرب النتيجة  .