Foksh

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

وعليكم السلام ورحمة الله وبركاته .. مشاركة مع أخي جعفر .. كنت قد أضفت الخاصية هذه الى الأداة التي أشرت إليها . وهي في الزر Custom والذي وظيفته كانت استدعاء دالة محددة عامة من المديول مباشرة .. على سبيل المثال ولفكرتك التي طرحتها أعلاه . استعمل الدالة التالية بإضافتها داخل أي مديول :- Public Function ExportCurrentReportToSNP() On Error GoTo Err_ExportSNP Dim defaultFolder As String Dim filePath As String Dim rptName As String On Error Resume Next rptName = Screen.ActiveReport.Name If Err.Number <> 0 Then MsgBox "لا يوجد تقرير مفتوح ونشط حالياً لتصديره!", vbExclamation + vbMsgBoxRight, "تنبيه" Err.Clear Exit Function End If On Error GoTo Err_ExportSNP defaultFolder = "D:\_BackUp_Teacher\" If Dir(defaultFolder, vbDirectory) = "" Then MkDir defaultFolder End If filePath = defaultFolder & rptName & "_" & Format(Now(), "yyyy-mm-dd_hhmmss") & ".snp" DoCmd.OutputTo acReport, rptName, "SnapshotFormat(*.snp)", filePath, False, "", 0 MsgBox "تم استخراج ملف سناب شوت بنجاح وحفظه في:" & vbCrLf & vbCrLf & filePath, vbInformation + vbMsgBoxRight, "تم التصدير" Exit_ExportSNP: Exit Function Err_ExportSNP: If Err.Number = 2501 Then MsgBox "لا يوجد سجلات لتصديرها أو تم إلغاء العملية.", vbOKOnly + vbMsgBoxRight, "تنبيه" Else MsgBox "حدث خطأ غير متوقع: " & Err.Description, vbCritical + vbMsgBoxRight, "خطأ رقم " & Err.Number End If Resume Exit_ExportSNP End Function ثم اذهب الى نموذج الأداة ، وقم بإنشاء قائمة مختصرة جديدة أو افتح قائمة موجودة . وانقر الزر Custom . واتبع ما يلي :-

هذه سنتعلمها منك 😇 .

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

وإياكم بالخير جُزيتم .. و جبر الله خاطركم .. هذه فكرتي التي كنت قد ارفقت توضيحها في الصورة سابقاً .. emad (2).accdb

هذه محاولتي البسيطة ..

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

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

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

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

تفضل .. 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 )