Foksh

وعليكم السلام ورحمة الله وبركاته ,,
طبعاً قبل البدء بطرح الحل ، وجب التنبيه إلى ضرورة أن تكون الأرقام في الخلايا التي بها اللون تطابق نفس اللون للخلايات التي سيكون لها التعداد ..
الدالة بسيطة كالتالي ضعها في مديول ..
Function CountByColor(rng As Range, clr As Range) As Long Dim c As Range Dim cnt As Long cnt = 0 For Each c In rng If c.Interior.Color = clr.Interior.Color Then cnt = cnt + 1 End If Next c CountByColor = cnt End Function  
ثم الإستدعاء بالشكل التالي مع حرية تحديد النطاق وخلية اللون :-
=CountByColor(B7:B100, A2)  
الملف بعد التطبيق :-
111.xlsm

وعليكم السلام ورحمة الله وبركاته ..
جري استخراج القيم من الخليتين كنص . في أي خلية تريدها استخدم المعادلة التالية :-
=TEXT(C3,"yyyy/mm/dd") & " " & TEXT(B3,"yyyy/mm/dd")  

وعليكم السلام ورحمة الله وبركاته ..
أهلاً بك معلمي الفاضل @jjafferr ، وأشكرك جداً على هذه الملاحظة الدقيقة والمهنية . نقطتك في محلها تماااااماً ؛ فالتحديث الأول أوقف التايمر الخاص به فقط ولكنه لم يتدخل في تايمرات النماذج التقليدية ( Timer Interval ) كاستخدامك لها في الـ ( Hot Folders ) ، مما استمر في مقاطعتك كمطور عند كتابتك للأكواد داخل المحرر .
ولذلك ، ولحل هذه المعضلة بشكل جذري وجعل الفكرة ناجحة 100% ، قمت بتوسيع مهام حدث الويندوز ForegroundChangedProc .
الفكرة الآن أنه وبمجرد مرور تركيز الويندوز إلى نافذة محرر الأكواد VBA ، سيقوم الكود بمسح جميع النماذج المفتوحة بلحظة واحدةً ، وبالتالي يحفظ قيم التايمر لها - عند وجود الحدث فقط - في ذاكرة مؤقتة ، ويجعل التايمر = 0 . وعند إغلاقك المحرر ، سيعيد الاستئناف بدقة لكل نموذج بناءً على ما تم حفظه في الذاكرة .
وقد تم الاعتماد على خصيصة hWnd كمعرف فريد للنماذج بدلاً من اسمها تفادياً لأي خطأ ( في حال كنت تستدعي أكثر من نسخة لنفس الحدث ) 😅 .
سنقوم بالإعلان عن متغير ( الذاكرة المؤقتة ) الذي ستعيش وتموت مع فتح وإغلاق محرر الأكواد VBA ، كالآتي :- Private colPausedForms As Collection  
الإضافة الثانية ( عملية الإيقاف والفكشنة عند فتح VBA ) . وتكون في الجزء الأول من دالة ForegroundChangedProc داخل شرط If IsVBEOpen() Then ، وهي المسؤولة عن حصر النماذج المفتوحة لدالة الصيد لتقوم بإيقافها وتتبع النماذج الفرعية داخلها :- Set colPausedForms = New Collection Dim frmMain As Object For Each frmMain In Forms PauseAllTimers frmMain Next frmMain  
الإضافة الثالثة ، وتكون في الجزء الثاني Else عند إغلاق الـمحرر ، وهي المسؤولة عن إعادة الروح للتايمرات وقيمها الأصلية كما كانت عليه :- If Not colPausedForms Is Nothing Then Dim frmMain2 As Object For Each frmMain2 In Forms ResumeAllTimers frmMain2 Next frmMain2 Set colPausedForms = Nothing End If  
أما الإضافة الرابعة والأخيرة 😅 ( دالتين صغيرتين بمثابة محركات البحث المتداخل ) ، لكتابة وحفظ البصمات 😁 :- Private Sub PauseAllTimers(frm As Object) If frm.TimerInterval > 0 Then On Error Resume Next colPausedForms.Add frm.TimerInterval, CStr(frm.Hwnd) frm.TimerInterval = 0 On Error GoTo 0 End If Dim ctl As Object On Error Resume Next For Each ctl In frm.Controls If ctl.ControlType = 112 Then If Not ctl.Form Is Nothing Then PauseAllTimers ctl.Form End If Next ctl On Error GoTo 0 End Sub Private Sub ResumeAllTimers(frm As Object) On Error Resume Next Dim savedInterval As Long: savedInterval = 0 savedInterval = colPausedForms(CStr(frm.Hwnd)) If savedInterval > 0 Then frm.TimerInterval = savedInterval Dim ctl As Object For Each ctl In frm.Controls If ctl.ControlType = 112 Then If Not ctl.Form Is Nothing Then ResumeAllTimers ctl.Form End If Next ctl On Error GoTo 0 End Sub  
الآن الكود بحلته الجديدة وملفه الجديد تالياً ( فضلاً لا أمراً ، افتح النموذج Frm_WithTimerInterval ) وضع به ما شئت من نماذج فرعية بداخل بعضها البعض ذات تايمرات مستمرة ! ثم جرب الدخول إلى المحرر
 
 
 
 
Time With No TimerInterval.accdb

تنفيذاً لفكرة وطلب أخي الأستاذ @ناقل ، تفضل هذا التعديل .
حيث تم انشاء جدول يضم حقل الرقم وحقل الحالة وحقل تاريخ التحقق وحقل ملاحظات
وإضافة زر جديد في النموذج السابق مع الكود التالي كتجربة :-
Private Sub Btn_CheckAll_Click() On Error GoTo ErrHandler Dim db As DAO.Database Dim rs As DAO.Recordset Dim PhoneNumber As String Set db = CurrentDb Set rs = db.OpenRecordset("SELECT * FROM Tbl_WhatsAppNumbers WHERE Status IS NULL OR Status='غير معروف'", dbOpenDynaset) If rs.EOF Then MsgBox "لا توجد أرقام بحاجة للفحص", vbInformation + vbMsgBoxRight, "" GoTo ExitHandler End If Do Until rs.EOF PhoneNumber = Nz(rs!PhoneNumber, "") If PhoneNumber <> "" Then ShellExecute 0, "open", "whatsapp://send?phone=" & PhoneNumber, vbNullString, "", 1 SendKeys "{TAB}", True Sleep 1000 SendKeys "{ENTER}", True If IsWhatsAppWindowOpen("الرقم غير مسجل في واتساب") Then rs.Edit rs!Status = "غير مسجل" rs!LastChecked = Now rs.Update Else rs.Edit rs!Status = "مسجل" rs!LastChecked = Now rs.Update End If End If Sleep 500 rs.MoveNext Loop MsgBox "تم فحص جميع الأرقام غير المعروفة", vbInformation + vbMsgBoxRight, "" SendKeys "{NUMLOCK}", True ExitHandler: On Error Resume Next rs.Close Set rs = Nothing Set db = Nothing Exit Sub ErrHandler: MsgBox "حدث خطأ: " & Err.Description, vbCritical, "خطأ" Resume ExitHandler End Sub  

 
Check Number.zip

تحسين الإتصال بقاعدة البيانات الخلفية ( الجداول ) ، وتلافي أخطاء محتملة ..
تحسين واجهة العرض الرئيسية ( شاشة الإنتظار ) ، وتحسين سرعة تحديث البيانات على الشاشة .
عدم إتاحة الفرصة لأي مستخدم باختيار قاعدة بيانات خلفية غير المسموح بها .
توسيع صلاحيات المدير بإضافة ميزة النسخ الإحتياطي ( إنشاء و إستعادة ) . وهذه الميزة جديدة بطريقتها ، بحيث تتميز بـِ :-
          التعامل مع الجداول فقط عند النسخ الإحتياطي أو الإستعادة ، وليس كقاعدة كاملة . ولكن بسهولة ويسر ..
          التعامل بإحترافية مع تضمين كلمة المرور الحالية للقاعدة المرتبطة ضمن اسم النسخة الإحتياطية ( باستخدام تشفير بسيط Base64 ) .
          سهولة تمرير كلمة المرور لكل قاعدة يتم استعادتها أو ربطها من النسخ الإحتياطية - دون الحاجة إلى كتابة كلمة مرور قاعدة بيانات الجداول - حتى لو اختلفت من نسخة الى نسخة .
          توحيد مجلد قاعدة البيانات الخلفية في مكان واحد لجميع الأجهزة المرتبطة عند الإستعادة لأي نسخة احتياطية .
          عملية ربط ديناميكية سريعة محدثة عن النسخة السابقة .
نظام رسائل تنبيه حديث ومتطور ( بدلاً من رسائل آكسيس ) . حيث تم الإستغناء عن 90% من رسائل آكسيس التقليدية MsgBox .
تحسين تفاعل شاشة المدير مع المستخدم .
 

افتح أولاً قاعدة بيانات المدير (Manager Controls) ، وسيُـطلب منك اختيار قاعدة بيانات الجداول الخلفية المرفقة بجانب قاعدة البيانات حاليــــــاً بإسم (TBL) ، والغير محمية بكلمة مرور طبعاً - ( الأمر اختياري لك ) .
الآن تباعاً سيتم نسخ قاعدة البيانات الى المجلد TBL:-
 
\Data\TBL انتهى دور المدير في الوقت الحالي . الآن بالتسلسل سيقوم كل موظف / جهاز حجز الدور / شاشة عرض الإنتظار بتشغيل قاعدة بياناتــــه ، وسيطلب منه تحديد قاعدة البيانات الخلفية بشكل يدوي أول مرة طبعاً فقط . وهنا فقط تستطيع الربط مع القاعدة الموجودة في المجلد \Data\TBL في مساره على الجهاز الرئيسي طبعاً .
بعد تحديد مسار الملف بغض النظر عن موقعه ( شبكة محلية / بجانب قاعدة البيانات ... إلخ ) سيتم فتح نافذة - ( الصورة أدناه ) - تطلب منك إدخال كلمة مرور الجداول ، فإذا كانت محمية بكلمة مرور فقم بكتابتها . وإلا اضغط موافق واترك الخانة فارغة للمتابعة بدون كلمة مرور .

ونكون قد انتهينا من الربط وتهيأة النظام للعمل 😅 .
 
:-
      دائماً يسعدني إبدائكم الرأي والملاحظات حول الأخطاء والمشاكل التي يمكن مواجهتها في أي مشروع يتم تأسيسه في آكسيس أو غيره من لغات البرمجة .
      في حال رغبتك أخي المستخدم بإضافة التقارير ، فقد تم تأسيس الجداول بسهولة ودون تعقيد ، وبعدد حقول قليل ويخدم جميع البيانات التي تحتاجها .
 

QMS 1.30.zip

هههههههه ، يا عيني عليك ، اكتشفتها بنفسك ..
جرب التعديل الأخير على أكثر من احتمال :-
Sub DrawCirclesByFoksh(ByVal x As Integer, ByVal startRow As Integer, ByVal endRow As Integer) Dim Shp As Shape, c As Range Dim r As Long, i As Long, n As Long Dim usedRows As Collection Dim dayCount As Long, perDay As Long, extra As Long Dim rr As Variant, lastCol As Long Dim hasLesson As Boolean Dim lessonCount As Long Dim circlesThisDay As Long If x <= 0 Then Exit Sub Set usedRows = New Collection lessonCount = 0 For r = startRow To endRow hasLesson = False For i = 3 To 10 If Cells(r, i).Value <> "" Then hasLesson = True lessonCount = lessonCount + 1 End If Next i If hasLesson Then usedRows.Add r Next r dayCount = usedRows.Count If dayCount = 0 Then Exit Sub n = 0 If x = lessonCount Then For r = startRow To endRow For i = 10 To 3 Step -1 If Cells(r, i).Value <> "" Then Set c = Cells(r, i) Set Shp = Sheet1.Shapes.AddShape(msoShapeOval, c.Left, c.Top, c.Width, c.Height) Shp.Fill.Visible = msoFalse Shp.Line.Weight = 1 Shp.Line.ForeColor.SchemeColor = 10 n = n + 1 If n = x Then Exit Sub End If Next i Next r ElseIf x > lessonCount Then Do While n < x For r = startRow To endRow For i = 10 To 3 Step -1 If Cells(r, i).Value <> "" Then Set c = Cells(r, i) Set Shp = Sheet1.Shapes.AddShape(msoShapeOval, c.Left, c.Top, c.Width, c.Height) Shp.Fill.Visible = msoFalse Shp.Line.Weight = 1 Shp.Line.ForeColor.SchemeColor = 10 n = n + 1 If n = x Then Exit Sub End If Next i Next r Loop Else perDay = x \ dayCount extra = x Mod dayCount If x > 10 And x < lessonCount Then extra = extra + 1 For Each rr In usedRows circlesThisDay = perDay If extra > 0 Then circlesThisDay = circlesThisDay + 1 extra = extra - 1 End If lastCol = 0 For i = 10 To 3 Step -1 If Cells(rr, i).Value <> "" Then lastCol = i Exit For End If Next i For i = lastCol To 3 Step -1 If Cells(rr, i).Value <> "" And circlesThisDay > 0 Then Set c = Cells(rr, i) Set Shp = Sheet1.Shapes.AddShape(msoShapeOval, c.Left, c.Top, c.Width, c.Height) Shp.Fill.Visible = msoFalse Shp.Line.Weight = 1 Shp.Line.ForeColor.SchemeColor = 10 circlesThisDay = circlesThisDay - 1 n = n + 1 If n = x Then Exit Sub End If Next i Next rr End If End Sub  

،،
جرب اجعل المعادلات في :-
J2 =
=IFERROR(IF(INDEX(Q:Q, MATCH(B5, P:P, 0)) = H2, "P", ""), "") J3 =
=IFERROR(IF(INDEX(Q:Q, MATCH(B5, P:P, 0)) = H3, "P", ""), "") J4 = 
=IFERROR(IF(INDEX(Q:Q, MATCH(B5, P:P, 0)) = H4, "P", ""), "")  
وعدل الخلية B5 لتصبح :-
=IFERROR(IF(MATCH(INDEX(data!$P$2:$P$23, MATCH($E$1, data!$R$2:$R$23, 0)), $P$2:$P$13, 0), INDEX(data!$P$2:$P$23, MATCH($E$1, data!$R$2:$R$23, 0)), ""), "") لتلافي الخروج عن نطاق P2 - P13
 
 

اعتقد انك هنا تحاول الوصول الى قيمة عنصر موجود في النموذج ، وليس من خلال قيمة حقل داخل جدول.
هل جربت كطريقة بسيطة استخدام Dlookup  على سبيل المثال 
 
stDocName = "tbl_student1" & DLookup("Year_name", "tbl_basic")  

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

وعليكم السلام ورحمة الله وبركاته ..
هل جربت أن تحدد الشرط للحقل StuSery داخل الاستعلام مصدر التقرير أن يساوي Is Null
 

🤔
يعني تريد ألغاء الدمج للخلايا التي تم دمجها ، مع إعادة القيم لكل خلية !!!
تمام ، جرب هذا الماكرو أ واستعمله في حدث عند النقر لأي زر مثلاً :-
Sub UnMergeFoksh() Dim ws As Worksheet Dim r As Long, c As Long Dim mArea As Range Dim cellText As String Set ws = ActiveSheet Application.ScreenUpdating = False Application.EnableEvents = False Application.Calculation = xlCalculationManual For r = 4 To 20 For c = 2 To 36 If ws.Cells(r, c).MergeCells Then Set mArea = ws.Cells(r, c).MergeArea cellText = ws.Cells(r, c).Text mArea.UnMerge mArea.NumberFormat = "@" mArea.Value = "'" & cellText mArea.HorizontalAlignment = xlCenter mArea.VerticalAlignment = xlCenter End If Next c Next r Application.Calculation = xlCalculationAutomatic Application.EnableEvents = True Application.ScreenUpdating = True End Sub  
طبعاً اعتقد انك هنا ستستغني عن حدث عند التغيير للورقة السابق .. ويصبح ملفك كالتالي للحدثين مع إضافة زرين .
 
merge cell.xlsm

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

وهذه فكرة تجمع بين عرض التكرارات التي يتنافس فيها الطلاب حسب رغبتك ..
Data_Base_Rep.zip

وعليكم السلام ورحمة الله وبركاته ..
بدايةً وللتأكيد مما فهمت ، انت تريد فتح التقرير بناءً على الشرطين ، بحيث يتم فتح التقرير من الزر في النموذج الفرعي 🙄 !!!
هكذا ... ؟؟؟
 
saad.zip
 
أم أنا فهمت الفكرة بشكل خاطئ 😅

السلام عليكم ورحمة الله وبركاته ..
الحل النهائي بعد تجربته مراراً وتكراراً . انتقل الى الرابط التالي هنا وحمل الملفات منه بدايةً .
وفي التالي شرح مصور مع الأخطاء وكيفية علاجها .

 
طبعاً تم ترك الأخطاء التي مررت بها كي يسهل على المستخدم الكشف عن الخلل وكيفية الإستدلال عليه وإصلاحه .

من المفترض انها نماذج إدخال بيانات وليست نماذج عرض سجلات ، إلا اذا كنتي رح تضطري تضغطي 50 مرة للبحث عن سجل معين داخل سجلات الجدول !!!! 
على العموم ، تم إضافة زرين ( التالي - السابق ) للنموذجين مع دالة تستعرض السجلات الخاصة بالموظف الحالي فقط ..
 
تفضلي :-
ربط واجهات3.zip

وعليكم السلام ورحمة الله وبركاته ...
بعد تتبع مصدر مربع النص Text2 .. وجدت أن أفضل حل هو الحدث التالي بعد تحديث عنصر الـ Ch1 ، بحيث يكون :-
Private Sub ch1_AfterUpdate() Dim subForm As Form Set subForm = Me.FMBoxCustomersSup.Form If Me.ch1 = True Then subForm.Filter = "([Sumمنtotalmainstax] - [Sumمنtotal_shop]) - [Price1] <> 0" subForm.FilterOn = True Else subForm.FilterOn = False End If End Sub  
وطبعاً في حدث عند التحميل للنموذج الرئيسي ، نقوم باستدعاء حدث بعد التحديث للعنصر Ch1 ، ليصبح كالتالي :-
Private Sub Form_Load() DoCmd.Maximize ch1_AfterUpdate End Sub  
ملفك بعد التعديل :-
اظهار واخفاء السجلات حسب قيمة الحقل.zip

وعليكم السلام ورحمة الله وبركاته ..
جرب هذين المرفقين بأسلوبين قريبين من بعضهما ..
 
 
Split Nums - 1.accdb Split Nums - 2.accdb

Minesweeper.zip   
 

أخي الفاضل ، لم لا تقوم بطرح جميع المطلوب كاملاً بدلاً من النقاط المبعثرة 😅
على العموم ، هذا التعديل لما طلبت ، تفضل ، استبدل الكود للزر بالتالي :-
Private Sub btnGenerate_Click() Dim db As DAO.Database Dim tDef As DAO.TableDef Dim fld As DAO.Field Dim rs As DAO.Recordset Dim startDate As Date, endDate As Date, d As Date Dim yearInput As Integer Dim monthName As String Dim monthCode As Integer Dim shiftValue As Double Dim startDateTime As Date Dim endDateTime As Date Dim monthEndDate As Date Dim monthEndWorkDate As Date If IsNull(TxtYear) Then MsgBox "أدخل رقم السنة", vbExclamation + vbMsgBoxRight, "" Me.TxtYear.SetFocus Exit Sub End If yearInput = Me.TxtYear startDate = DateSerial(yearInput - 1, 12, 21) endDate = DateSerial(yearInput, 12, 20) On Error Resume Next DoCmd.DeleteObject acTable, "Salary" On Error GoTo 0 Set db = CurrentDb db.Execute "CREATE TABLE Salary (" & _ "ID AUTOINCREMENT PRIMARY KEY, " & _ "WorkDate DATE, " & _ "DayName TEXT(20), " & _ "MonthName TEXT(20), " & _ "monthCode LONG, " & _ "shift CURRENCY, " & _ "startDay DATE, " & _ "endDay DATE)" Set tDef = db.TableDefs("Salary") Set fld = tDef.Fields("shift") On Error Resume Next fld.Properties("Format") = "#,##0.00" If Err.Number <> 0 Then Err.Clear fld.Properties.Append fld.CreateProperty("Format", dbText, "#,##0.00") End If fld.Properties("DecimalPlaces") = 2 If Err.Number <> 0 Then Err.Clear fld.Properties.Append fld.CreateProperty("DecimalPlaces", dbInteger, 2) End If Set fld = tDef.Fields("startDay") On Error Resume Next fld.Properties("Format") = "hh:nn AM/PM" If Err.Number <> 0 Then Err.Clear fld.Properties.Append fld.CreateProperty("Format", dbText, "hh:nn AM/PM") End If Set fld = tDef.Fields("endDay") On Error Resume Next fld.Properties("Format") = "hh:nn AM/PM" If Err.Number <> 0 Then Err.Clear fld.Properties.Append fld.CreateProperty("Format", dbText, "hh:nn AM/PM") End If On Error GoTo 0 Set fld = Nothing Set tDef = Nothing Set rs = db.OpenRecordset("Salary", dbOpenDynaset) monthCode = 0 monthEndWorkDate = DateSerial(yearInput - 1, 12, 20) d = startDate Do While d <= endDate If Weekday(d, vbMonday) <> 5 And Weekday(d, vbMonday) <> 7 Then monthName = CustomMonth(d) monthCode = 0 monthEndDate = DateSerial(Year(d), Month(d), 20) If Weekday(monthEndDate, vbMonday) = 5 Or Weekday(monthEndDate, vbMonday) = 7 Then monthEndWorkDate = monthEndDate Do monthEndWorkDate = DateAdd("d", -1, monthEndWorkDate) Loop Until Weekday(monthEndWorkDate, vbMonday) <> 5 And Weekday(monthEndWorkDate, vbMonday) <> 7 Else monthEndWorkDate = monthEndDate End If If d = monthEndWorkDate Then If Month(d) = 12 And Year(d) = yearInput - 1 Then monthCode = 1 ElseIf Month(d) = 1 And Year(d) = yearInput Then monthCode = 1 ElseIf Month(d) = 2 Then monthCode = 2 ElseIf Month(d) = 3 Then monthCode = 3 ElseIf Month(d) = 4 Then monthCode = 4 ElseIf Month(d) = 5 Then monthCode = 5 ElseIf Month(d) = 6 Then monthCode = 6 ElseIf Month(d) = 7 Then monthCode = 7 ElseIf Month(d) = 8 Then monthCode = 8 ElseIf Month(d) = 9 Then monthCode = 9 ElseIf Month(d) = 10 Then monthCode = 10 ElseIf Month(d) = 11 Then monthCode = 11 ElseIf Month(d) = 12 Then monthCode = 12 End If End If If Weekday(d, vbMonday) = 6 Or Weekday(d, vbMonday) = 3 Then shiftValue = 1 startDateTime = DateAdd("n", 30, DateSerial(Year(d), Month(d), Day(d)) + TimeSerial(8, 0, 0)) endDateTime = DateSerial(Year(d), Month(d), Day(d)) + TimeSerial(13, 30, 0) Else shiftValue = 1.2 startDateTime = DateAdd("n", 10, DateSerial(Year(d), Month(d), Day(d)) + TimeSerial(8, 0, 0)) endDateTime = DateSerial(Year(d), Month(d), Day(d)) + TimeSerial(14, 30, 0) End If rs.AddNew rs!WorkDate = d rs!DayName = Format(d, "dddd") rs!monthName = monthName If monthCode > 0 Then rs!monthCode = monthCode Else rs!monthCode = Null End If rs!shift = shiftValue rs!startDay = startDateTime rs!endDay = endDateTime rs.Update End If d = d + 1 Loop rs.Close Set rs = Nothing db.TableDefs.Refresh Set db = Nothing MsgBox "تم إنشاء الجدول بنجاح", vbInformation + vbMsgBoxRight, "" DoCmd.SelectObject acTable, "Salary", True End Sub  
ملفك بعد التعديل :-
CalGen.zip
 

أخي @jo_2010
بما أن موضوع الحدث عند رسم النموذج يسبب مشكلة لديك ، دعنا نتوجه إلى الحل التالي . وهو إضافة بسيطة الى الاستعلام مصدر النموذج الفرعي ليصبح كالتالي :-
SELECT Switch([External_lab] Is Null,Null,[External_lab]="",Null,[External_lab]="المختبر","Almokh",[External_lab]="البرج","1_AL_Borg",True,Null) AS DisplayImage, * FROM [Qry_Analysis collection]; بدلاً من القديم :-
SELECT [Qry_Analysis collection].* FROM [Qry_Analysis collection]; وطبعاً سنحدد مصدر عنصر الصورة التي تريدها ليصبح الحقل الجديد = DisplayImage
وبالتالي النتيجة بدون ترميش وتعتمد على مصدر النموذج الفرعي نفسه . والنتيجة في المرفق .
 

تم تغيير اسم عنصر الصورة من Image ( وهو اسم محجوز لآكسيس وهو غير صحيح ) الى الاسم ImageFoksh .
ومن الجدير بالذكر والتوضيح أنني اعتمدت على اسم الصورة المضمنة في قاعدة البيانات نفسها .
 

 
JO_Lab3.zip

هذه تجربتي المباشرة على الإصدار الحديث Version 2.3000.1031261430.258708 . أحدث من إصدارك حتى ، مع العلم أن إصدارك تمت التجربة عليه سابقاً ( التطبيق موجود ضمن المشاركات ) .. انظر هذا التصوير :-
 

 

وعليكم السلام ورحمة الله وبركاته ..
جرب هذا التعديل أخل الكريم ..
 
DCOUNT.zip

وعليكم السلام ورحمة الله وبركاته ..
جرب في زر فتح التقرير الحدث التالي :-
DoCmd.OpenReport "تقرير تصفية", acViewPreview, , _ "[اسم_المستفيد] Like '*" & Forms!Index!s & "*' " & _ "OR [رقم/اسم المبنى] Like '*" & Forms!Index!s & "*' " & _ "OR [الادارة] Like '*" & Forms!Index!s & "*'"  
100.zip

وعليكم السلام ورحمة الله وبركاته..
في مربع نص الاسم اختر تنسيق شرطي ، واضف قاعدة جديدة ، واختر Expression Is ، ثم في قيمة الشرط اكتب مثلاً:-
[Foksh] = "لا يوجد" انا افترضت هنا ان اسم مربع النص الذي تشترط قيمته = Foksh  😅 . ثم حدد اللون والتنسيق الذي تريده .