نجوم المشاركات

السلام عليكم يمكن عمل ذلك بقك الحماية في بداية اي كود ثم اعادة الحماية في نهاية الكود كلمة الحماية 123 يمكنك تعديلها بالكود جدول الحراسة.xlsm

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

وعليكم السلام ورحمة الله وبركاته .. مشاركة مع أخي جعفر .. كنت قد أضفت الخاصية هذه الى الأداة التي أشرت إليها . وهي في الزر 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 . واتبع ما يلي :-

جزاك الله خيرا .. جبرت بخاطر اخيك

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

وعليكم السلام ورحمة الله وبركاته استاذنا الفاضل طلبك واضح ولكن ملفك المرفق لا يتوافق مع طلبك الطلب الثاني والثالت في شيت Horaire2027 عدد الخلايا 8 وفي الشيتين المرحل اليها 9 خلايا وخود كلمة المؤسسة في الشيتين Feuil12 وFeuil13 وعدم وجودها في شيت Horaire2027 على كل حال الكود المرفق تم عمله حسب الموجود في شيت Horaire2027 وهي 8 خلايا حسب الشيت المرفق تم تقسيم الكود الى جزئين بزرين الاول للترحيل الى Feuil1 وFeuil12 والكود الثاني الى وFeuil13 Horaire-18-06-2026-(04.12.06).xlsb

وما أقصده هو أنه يوجد طريقة لدمج وظيفة التصدير كـ PDF للتقارير في اكسيس 2003 .. فإن كنت ترغب بها سأحاول دمجها من ضمن التحديثات التي تمت على أداة إنشاء القوائم المختصرة .

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

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

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

وعليكم السلام ورحمة الله وبركاته اذا الامر لا يحتاج الى كود ترحيل يمكنك كتابة البيانات مباشرة في سيت Feuil1 ثم شيت Feuil12 خاص باللون الاصفر وليس الازرق كما ذكرت ولا وجود لكلمة المؤسسة في الخلايا الصفراء في شيت Horaire2027 بالنسبة نعم يوجد خطا في رقم الصف المرحل- فقط قم بتغيير B3:I3 الى B4:I4 في مكانين بالكود حسب الموضح الاتي For Each cell In wsSource.Range("B3:I3, B6:I6, B9:I9") الى For Each cell In wsSource.Range("B4:I4, B6:I6, B9:I9") وكذلك تغيير wsFeuil1.Cells(nextRow1, 1).Resize(1, 8).Value = wsSource.Range("B3:I3").Value الى wsFeuil1.Cells(nextRow1, 1).Resize(1, 8).Value = wsSource.Range("B4:I4").Value قم بتجهيز ملفك جيدا وحسب ما اذكر اعتقد انها المرة الخامسة او السادسة تم تعديل نفس الكود خلال الاشهر القليلة الماضية

شكرا لك على هذا الكرم وهذه مفاتيح API تفتح لكم الباب للامحدودية اليومية للعدد اليومي .. 😎

مشاركة مع اخي ابو البشر تفضل تم التعديل وتحقيق مطلبك Database2.rar

أدبا .. العمل لك ؟ ومن اناملك يكون اجمل

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

أخي الكريم ، الفكرة ليست بمعادلة وينتهي الموضوع !!!! بناءً على ملفك المرفق فإنه حتى المعادلة لن تأتي لك بالمطلوب لأسباب كثيرة . نمط التاريخ وشكله وتنسيقه غير واضح في الخلايا داخل الورقات اليومية . الخلية التي سيكون بها تاريخ المقارنة يجب أن يكون في خلية ثابتة في جميع الورقات . خلية عرض الصافي أيضاً يجب أن تكون في خلية ثابتة . فليس من المنطقي أن تكون مرة في 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

السلام عليكم مرفق الملف بعد التعديل لعله المطلوب Copy of Horaire-18-06-2026-(04.12.06).xlsb

السلام عليكم الجزء الاول هو المرجع لتوضيح عمل القائمة المختصرة : . في الموضوع السابق ، تحدثنا عن القائمة الثابتة ، وفي هذا الموضوع سنتكلم القائمة المؤقتة ، وعن طرق اخرى لإستعمال القائمة. وللعلم ، هناك قائمة مختصرة للنموذج واخرى للحقل ، سواء قائمة ثابته او مؤقته . القائمة الثابتة هي التي تجدها جاهزة للاستعمال ، وبدون عمل اي كود لها ، سواء في النموذج او التقرير ، مثلا : . اما القائمة المؤقته فيحتاج تناديها بالكود لكل استعمال ، ولما تغلق النموذج/التقرير ، يحتاج تحذفها ، والسبب مثل ما بتشوفون في المرفق ، نستعمل نفس القائمة ببعض الاختلافات بين النموذج/التقرير وحقوله. . التحدي الاكبر في القائمة المؤقته ليس البرمجة ، وانما معرفة الحدث الصحيح للحصول على النتيجة ، ثم تمرير النتيجة ، مثلا ، للحصول على عدد صفحات التقرير ، يجب استعمال الحدث On Page ، ومنها اخذ عدد الفحات وتمريرها الى دالة القائمة المؤقته. حاولت عمل اكبر قدر من التشكيلات ، وبأبسط طرق البرمجة ، حتى يكون تغييرها سهل للمبرمج. وفي المرفق وحدة نمطية لتصدير/استيراد كائنات قاعدة البيانات ، وحسب طلب اخي العزيز @ابوخليل ققد اضفت لها دالة لإرجاع كود القائمة المختصرة (اذا صارت الحاجة اليه). myRight_Click_Shortcut_Menu.zip