Foksh

جميل .. فكرة حلوة . لم لا تشاركنا إياها 😉 ، ونتعلم مما لديكم 😇

لمحة عن النظام الجديد

بخصوص هذه النقطة :- هل هو مفروض عليك أن تملأ الفراغات ؟؟؟؟؟؟؟؟؟؟؟؟ وبخصوص :- هل هكذا تقصد بالصفوف الفارغة الإحتياطية ؟؟

هل جربت ؟؟؟ ما النتيجة التي صادفتها ؟؟

تفضل .. emad.accdb اتجاه الورقة ولكن بلا أدنى شك أنه ليس الحل الصحيح ,, انا لجأت لكلمة حيلة فقط

هههههههه ، اذا كذا الأمور بسيطة .. تتفضل 6NoGi3EQdt14ze2EgDhJikxp gkqDtA9bNm19paxNfgZuuCQQ gDjqVdH6a18n3e4xpTfnJryr sbnYXhbjR7R6DMB5tLYsK5EQ يكفي !!

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

وعليكم السلام ورحمة الله وبركاته .. مهندسنا الغالي تبارك الله ، ما شاء الله على الأفكار الجميلات الممتعات أحسن الله إليك ، ورفع قدرك على هذه الفكرة الجميلة .. بعد تجربتي الأداة تعمل 100% عندي . ولكن كان لي نقطة واحدة فقط وهي قراءة الرد من السيرفر بشكل أوضح . ما أقصده هو ، وكمثال بعد محاولات كثيرة حتى تم استنزاف رصيد الـ 50 محاولة المجانية لديكم :- والتنفيذ في الجزء :- Else Dim errTxt As String On Error Resume Next errTxt = http.responseText On Error GoTo 0 DoCmd.Hourglass False If InStr(errTxt, "unknown_foreground") > 0 Then MsgBox "We’re sorry, we couldn’t remove the background." & vbCrLf & _ "Try another image.", _ vbExclamation, "Remove Background" ElseIf http.Status = 401 Then MsgBox "API Key غير صحيح", vbCritical + vbMsgBoxRight, "Remove Background" ElseIf http.Status = 402 Then MsgBox "لم يعد لديك أي محاولات مجانية في هذا الحساب", vbCritical + vbMsgBoxRight, "Remove Background" Else MsgBox "حدث خطأ غير معروف:" & vbCrLf & _ http.Status & " - " & http.statusText, _ vbCritical + vbMsgBoxRight, "Remove Background" End If كما قمت بإيقاف السطر التالي أيضاً :- MsgBox "فشلت العملية" Moosak BG Remover.accdb

نعم صحيح .. لفصل الذكور عن الإناث في عامودين منفصلين . والتجميع والعرض تم على 3 حقول ( أولاً الصف ، ثانيا الفصل ، وثالثاً الجنس ). طبعاً اعتقد أننا نستطيع الاستغناء عن التجميع للصف بما أنه شرط الاستعلام . والإبقاء على الفصل والجنس فقط .. emad.accdb

أخي الكريم ، الفكرة ليست بمعادلة وينتهي الموضوع !!!! بناءً على ملفك المرفق فإنه حتى المعادلة لن تأتي لك بالمطلوب لأسباب كثيرة . نمط التاريخ وشكله وتنسيقه غير واضح في الخلايا داخل الورقات اليومية . الخلية التي سيكون بها تاريخ المقارنة يجب أن يكون في خلية ثابتة في جميع الورقات . خلية عرض الصافي أيضاً يجب أن تكون في خلية ثابتة . فليس من المنطقي أن تكون مرة في Q ومرة في R ومرة في F ... إلخ وعليه تم العمل من خلال ماكرو واستدعاؤه داخل الورقة الرئيسية كالتالي :- Sub GetValuesFromSheets() Dim wsCurrent As Worksheet Dim wsOther As Worksheet Dim i As Long Dim j As Long Dim targetDate As Date Dim found As Boolean Dim lastRow As Long Set wsCurrent = ThisWorkbook.ActiveSheet Application.ScreenUpdating = False Application.Calculation = xlCalculationManual wsCurrent.Range("C3:C33").ClearContents For i = 3 To 33 If wsCurrent.Cells(i, "B").Value <> "" Then If IsDate(wsCurrent.Cells(i, "B").Value) Then targetDate = CDate(wsCurrent.Cells(i, "B").Value) found = False For Each wsOther In ThisWorkbook.Worksheets If wsOther.Name <> wsCurrent.Name Then lastRow = wsOther.Cells(wsOther.Rows.Count, "B").End(xlUp).Row If lastRow > 33 Then lastRow = 33 For j = 3 To lastRow If wsOther.Cells(j, "B").Value <> "" Then If IsDate(wsOther.Cells(j, "B").Value) Then If CDate(wsOther.Cells(j, "B").Value) = targetDate Then wsCurrent.Cells(i, "C").Value = wsOther.Range("R27").Value found = True Exit For End If End If End If Next j End If If found Then Exit For Next wsOther If Not found Then wsCurrent.Cells(i, "C").Value = "غير موجود" End If End If End If Next i Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True End Sub Private Sub Worksheet_Activate() Call GetValuesFromSheets End Sub Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("B3:B33")) Is Nothing Then Call GetValuesFromSheets End If End Sub وهذا مرفقك بعد إجراء بعض التعديلات عليه وضبط المواضع التي تحدثت عنها سابقاً تصفيات العيادات.xlsm ملاحظة .. تم تعديل التاريخ في كل ورقة ليصبح 2026-06-19 2026-06-20 2026-06-21 2026-06-22

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

حياك الله أخي سعد ..

تمام ،، تفضل أخي أسعد :- emad.accdb

هكذا ؟؟

أخي أسعد ، في أول طلبك ، لم تأتِ على ذكر الصف ، بل الفصل .. على العموم وبحكم خبرتي القليلة في موضوع قواعد البيانات التي تختص بالمدارس .. 1. انت تريد أن تقوم باختيار الصف فقط !!!! 2. تريد في كل صفحة ان يتم عرض طلاب الصف الذي اخترته ولكن كل فصل منفصل !!!! 3. تريد توزيع الذكور والإناث في عامودين . هكذا ؟؟؟؟ أكد لي قبل أن أعتمد الحل ما لم يكن هناك خطأ في فهمي للمطلوب 😅

تفضل أخي أسعد .. جرب المرفق التالي ، وأخبرني إن كانت النتيجة هي ما تريده !! emad.accdb

وعليكم السلام ورحمة الله وبركاته .. مش متأكد إن كنت فهمتك صح ولا لأ .. ولكن جرب المرفق التالي :- emad.accdb

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

( الصورة من إنشاء الذكاء الإصطناعي Nano Banana 2 )

أخي جو ، تفضل فكرتي البسيطة التي تحدثت عنها سابقاً .. حيث ما تم هو :- اكتفيت بالجدول Tbl_Settings الذي يحتوي الحقل DefaultNumber = حقل نصي . تم تغيير نوع الحقل NO_Esal في الجدول Tbl_Lab_All من حقل محسوب الى حقل نصي . مربع النص الذي تقع عليه المسؤولية أصبح له الأحداث :- Private Sub Esal_AfterUpdate() Me.NO_Esal.Value = Me.C_NO.Value & Me.Esal.Value End Sub Private Sub Esal_DblClick(Cancel As Integer) Dim TaskDialog As Y_CTaskDialog Dim db As DAO.Database Dim rs As DAO.Recordset Set TaskDialog = New Y_CTaskDialog With TaskDialog .Init .ParenthWnd = Me.hwnd .Flags = TDF_INPUT_BOX + TDF_RTL_LAYOUT .MainInstruction = "رقـم الايصـال الاسـاسـى" .Content = "ما هـى ... القيمة الافتراضية للايصال " .CommonButtons = TDCBF_OK_BUTTON Or TDCBF_CANCEL_BUTTON .IconMain = IDI_QUESTION .InputBoxTextAlign = TDIBTA_Right .InputAlignInFooter = tdcaRight .InputAlign = TDIBA_Footer If Not IsNull(txtChoices) Then .InputWidth = txtChoices .InputCueBanner = " من فضلك أدخل رقم الايصال ؟ " .DefaultCustomControl = tdccNothing .ShowDialog If .ResultMain = 1 Then If IsNull(.ResultInput) Or Not IsNumeric(.ResultInput) Then MsgBox "يجب تحديد قيمة رقمية", vbMsgBoxRight, "قيمة خاطئة" Exit Sub Else Set db = CurrentDb() Set rs = db.OpenRecordset("Tbl_Settings", dbOpenDynaset) If rs.EOF Then rs.AddNew rs!DefaultNumber = .ResultInput rs.Update Else rs.Edit rs!DefaultNumber = .ResultInput rs.Update End If rs.close Set rs = Nothing Set db = Nothing End If Me.C_NO.Value = .ResultInput ElseIf .ResultMain = 2 Then Undo Exit Sub End If End With Set TaskDialog = Nothing End Sub مربع النص C_NO أخذ القيمة الإفتراضية :- =Nz(DLookUp("DefaultNumber","Tbl_Settings"),"0") وبالتالي ملفك بعد التعديل سيكون Lab_2026.zip جرب العمل عليه وأخبرني بالنتيجة إن كانت مطابقة لما تريده تماماً أم لا ..

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

وعليكم السلام ورحمة الله وبركاته .. حتى لا تتشتت أفكارك بعيداً عن طلبك ، ألقِ نظرة على هذا الموضوع هنا .

انا أعتذر من السير في حيلة من شأنها أن تدمر السجلات في أول خطأ يا صديقي .. لذلك قد أطرح فكرة تكون حلاً لك ، وهي الإعتماد على تعيين القيمة الافتراضية في جدول الإعدادات مثلاً . بحيث يتم تحديثها وجلبها متى شئت دون التأثير على خاصية الحقل داخل الجدول Tbl_Lab_All . فهنا نحن لن نقوم بإغلاق النموذج الرئيسي أو الفرعي أبداً . أو لن نقوم بفك ارتباط النماذج أساساً ( وبالتالي لن نجبر آكسيس على حفظ السجلات الناقصة ) . و ستبقى شاشة المستخدم مفتوحة كما هي ، والبيانات الناقصة التي تكتبها كمستخدم لن يتم حفظها إلا عندما تقرر حفظها . يعني باختصار = التعديل سيتم في جدول إعدادات خارجي بسيط ( Tbl_Settings ) غير مرتبط بالنماذج المفتوحة ، لذا لن تتواجد عوائق أخي جو . ومع ذلك ، فإن القيمة الافتراضية ستتعدل على مستوى الجدول نفسه ( وليس النموذج ) ، بحيث لو قام المستخدم بفتح الجدول مباشرة أو أضاف سجلاً من أي نموذج فرعي آخر ، سيتم تعيين القيمة الافتراضية الجديدة تلقائياً عند الحفظ . أرجو أن أكون قد نجحت بتوصيل فكرتي التي من خلالها لن تضطر للخروج من النموذج ، وبنفس الوقت ستبقى القيمة الافتراضية مخزنة داخل جدول ليس له اي علاقة بالنموذج سوى جملة DlookUp . وتحديثها من خلال سطر استعلام تحديث عند تغييرها 😉

شكراً للمشاركة أخي خليفة .. اذا من 25 سنة ، فقد عاشت الفكرة عمراً كافياً حتى تقوم الشركة بالإلغاء أو الحذف .😅. ثم إن الفكرة ستكون حصرية للمزود الذي سيقدم الخدمة حصراً !!!! يعني من سيستخدم الفكرة في الموزمبيق لن يكون لديه شريحة لمزود الخدمة هذا في بلده 😜 .

يمكن التنفيذ 😉 ..