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

أخواني وأساتذتي ومعلمينا ( دون استثناء ) أقدم لكم هدية بسيطة . وهي أداة لتحويل ملفات الـ PDF الى صور ( إستخراج الصفحات الى صور قابلة للإستخدام الحر ) . مميزات الأداة :- الأداة قادرة على التعرف على خصائص ملف الـ PDF الذي تم اختياره مثل ( تاريخ الإنشاء ، عدد الصفحات ، حجم الملف ) . الأداة تعمل بسرعة وكفاءة عالية . الأداة تمت تجربتها على ملف PDF يحتوي 1500 صفحة لفحص سرعة وجودة الصور المستخرجة . الأداة تتيح للمستخدم اختيار مجلد الإستخراج بشكل يدوي ( خاص به ) أو من خلال مجلد ديناميكي يتم انشاؤه بجانب ملف الأداة . الأداة لها إضافات لاحقة ( تحديثات جديدة ) . الأداة لا تقوم بتحويل ملفات الـ PDF إلى ملفات Doc أو Docx . لأن هذه الميزة تتطلب اشتراكات مدفوعة ( رغم علمي بأنه لا يوجد برنامج أو موقع قادر وبشكل صحيح 100% على التعامل مع النصوص العربية داخل ملفات الـ PDF معلومتي قابلة للخطأ والصواب ) . لاحقاً سيتم إضافة ميزة تحويل ودمج الصور التي تم استخراجها الى ملف Doc أو Docx ، بالتعرف الديناميكي على إصدار أوفيس المثبت على الكمبيوتر للمستخدم . صورة توضيحة لعمل الأداة :- تم تسريع الصورة قليلاً لغاية تقليل الحجم بأقصى حد ممكن مع محاولة عدم التأثير على جودة الصورة واجهة الأداة :- ملف الأداة بنسختين :- نسخة 64 بت PDF Converter - 64.zip نسخة 32 بت PDF Converter - 32.zip مرفق ملف PDF تعليمي - للتحربة :- تعلم آكسيس.pdf هنا

🌷 لقاءات أكسس العرب الافتراضية | 03 | 🌷 موضوع اللقاء : مهارات وفنيات تصميم النماذج واختيار الألوان وتنسيق العناصر رابط اليوتيوب: ★ روابط اللقاء الثالث ★ ○ موقع إلهام : https://www.pinterest.com https://www.freepik.com ○ مواقع اختيار الألوان : https://coolors.co https://colorhunt.co https://www.materialpalette.com https://coolors.co/gradients ○ مواقع الأيقونات : https://icons8.com/icons https://www.flaticon.com https://icon-icons.com/ https://www.iconarchive.com/ https://flaticons.net/free-icons ○ مواقع صور PNG : https://www.cleanpng.com https://www.pngwing.com https://www.seekpng.com ○ مواقع صور خلفيات : https://www.pexels.com https://www.freepik.com/free-photos-vectors/background https://pixabay.com https://www.vecteezy.com/free-photos/background https://stocksnap.io/search/background ○ مواقع الخطوط : https://fonts.google.com https://arbfonts.com خطوط رسومية : https://www.vertex42.com/ExcelTips/unicode-symbols.html https://www.ssec.wisc.edu/~tomw/java/unicode.html ○ مراجع مهمة : https://elshemy.me/content/2025_8/Access_UI_UX_ِGuide.html ★ روابط تهمك ★ ❀ ملفات اللقاءات الافتراضية : ○ https://shorturl.at/mR2T3 ○ اللقاء الأول : https://drive.google.com/drive/folders/1wiMVugVZNzU9eaJ9abX-YfqhhSG6_Ec5 ○ اللقاء الثاني : https://drive.google.com/drive/folders/1EcaTZBp0rhmxhm7c_NKOg6BC-O89DS4W ○ اللقاء الثالث : https://drive.google.com/drive/folders/1VX4an_hg3ZdX-Q9_MlNNPoCzkCN6b98d ○ برمـجيـات - أدوات - إضـافـات : https://drive.google.com/drive/folders/1RtmH-cuk1rpj0zKkUNPbQz681oqKVNo3 ○ مجلد ورش العمل المشتركة : https://drive.google.com/drive/folders/1LL5_hsElZR4zQv62Wt1TxU2_M8Gv1Jja ❀ رابط الانظمام لمجموعة الأكسس جروب (واتسأب) : https://chat.whatsapp.com/HQvOPGrkASM2guvAotHXCw ❀ قناة أكسس العرب (اليوتيوب) : http://www.youtube.com/@ArabAccessGroup ❀ مواضيع اللقاء : المقدمة الإلهام البصري pinterest الإلهام البصري Google اختيار الألوان المناسبة تطبيق الألوان على قاعدة البيانات الأيقونات النصية الأيقونات الأيقونات - برنامج Pichon إضافة الصور المفرغة PNG تصميم الواجهات عن طريق PowerPoint حفظ التصميم من الباوربوينت واستيراده إلى الأكسس تصميم نموذج تسجيل الدخول إضافة التفاعل البصري للعناصر تفاعل بصري بالتنسيق الشرطي التأثيرات البصرية التي تطبق على الأزرار الخطوط في النماذج وتنسيقاتها الأنماط اللونية أنماط الخطوط مشاهدة ممتعة 😊🌷

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

Try the file كود إخفاء واظهار شيتات محددة برقم سري والباقي ظهار.xlsm

اعرض الملف أداة تحويل محرر الأكواد للوضع الداكن Dark Theme {سلسلة الأدوات المساعدة المخصصة} هناك الكثير يفضل العمل في بيئة عمل داكنة لإنها تكون مريحة للعين أكثر وكما نعرف فإن طريقة تعيين ألوان محرر الأكواد طريقة طويلة ومعقدة بعض الشيئ لذا أقدم لكم هذه الأداة التي تقوم بتحويل محرر الأكواد VBE للوضع الداكن في جميع تطبيقات أوفيس وليس الأكسس فقط هذه الأداة بسيطة جداً ولا تتطلب إلا نقرة زر فقط قمت بتوضيح طريقة عمل الكود بالتفصيل ليتمكن أي شخص من تغيير الإعدادات التي يرغب بها مع تحياتي صاحب الملف منتصر الانسي تمت الاضافه 08/09/25 الاقسام قسم الأكسيس  

السلام عليكم هذه محاولة بحسب ما فهمت حل1 : اختر أول سطر للبيانات من القائمة المنسدلة الزرقاء حل2 : مباشرة بدون اختبار سيتم اختيار آخر سطر تفضل جديد1.xlsm

بعد إذن أستاذى الفاضل / hegazee تم تعديل بسيط للمعادلات إجمالى عدد المزارعين 914 / و/ احمد محمد عبدالله المساحة صفر 1 فئات الانتفاع.xlsx

وعليكم السلام ورحمة الله وبركاته .. حاولت التبسيط لك من خلال المعادلات و وجدت انك ستقوم بتكرار الكثير من المعادلات لكل عمود . لذا خطرت لي فكرة أبسط لك من خلال الكود التالي في زر :- Private Sub CommandButton1_Click() Dim wsSrc As Worksheet, wsDest As Worksheet Dim srcData As Variant, outData() As Variant Dim i As Long, j As Long, outRow As Long Dim lastRow As Long Set wsSrc = ThisWorkbook.Sheets("الوارد") 'تحديد الورقة المصدر Set wsDest = ThisWorkbook.Sheets("مشتريات") 'تحديد الورقة الهدف lastRow = wsSrc.Cells(wsSrc.Rows.Count, "F").End(xlUp).Row srcData = wsSrc.Range("B3:N" & lastRow).Value ' تم التوسيع حتى العمود N (عمود 14) ReDim outData(1 To UBound(srcData), 1 To 13) 'تحديد عدد الأعمدة outRow = 0 For i = 1 To UBound(srcData) If Trim(srcData(i, 5)) = "مشتريات" Then 'تحديد الشرط outRow = outRow + 1 For j = 1 To 13 'تحديد عدد الأعمدة outData(outRow, j) = srcData(i, j) Next j End If Next i If outRow > 0 Then wsDest.Range("B3").Resize(outRow, 13).Value = outData 'تحديد عدد الأعمدة End If End Sub وأضفت لك التعليقات لتفهم الفكرة في حال أردت التنفيذ على أوراق أو أفكار اخرى بتغيير الشروط والهدف والمصدر والأعمدة .... إلخ الملف المرفق ، في الورقة "مشتريات" انقر الزر فقط 😁 . خزينة المشتريات والتراخيص المركزية عام 2025-2026.xlsm

السلام عليكم ورحمة الله أشارك معكم اليوم أكواد داخل وحدة نمطية عامة تم تطويرها لتصفية محتويات أي مربع سرد (ComboBox) في أي نموذج بشكل ديناميكي بمجرد الكتابة داخل مربع التحرير والسرد تصفية ديناميكية: يدعم التصفية المتعددة باستخدام أكثر من حقل (مثل الاسم + الرقم القومي) تدعم التصفية على حقل واحد أو حقول متعددة باستخدام نمط LIKE '*...*' وذلك لتتم التصفية بناء على اى جزء من الكلمة الكود داخل الوحده النمطية العامة Option Compare Database Option Explicit Private dictRowSources As Object Private strLastFilterValue As String Private strLastComboName As String Private Sub EnsureDictionary() If dictRowSources Is Nothing Then Set dictRowSources = CreateObject("Scripting.Dictionary") End If End Sub Public Sub ClearComboMemory(ByVal frm As Access.Form) Dim strKey As Variant Call EnsureDictionary For Each strKey In dictRowSources.Keys If Left(strKey, Len(frm.Name) + 1) = frm.Name & "." Then dictRowSources.Remove strKey End If Next End Sub Public Sub FilterCombo(ByVal frm As Access.Form, _ ByVal strComboName As String, _ Optional ByVal strFilterField As String = "") Dim cmb As Access.ComboBox Dim strSourceSQL As String Dim strFilterValue As String Dim strFilteredSQL As String Dim strOrderByClause As String Dim strKey As String Dim objRegex As Object Dim objMatches As Object Dim arrFilterFields As Variant Dim strWhereClause As String Dim i As Long On Error GoTo ExitWithError ' التحقق من صحة النموذج وعنصر التحكم If frm Is Nothing Then MsgBox "النموذج غير صالح.", vbExclamation Exit Sub End If ' Debug.Print "Form: " & frm.Name ' Debug.Print "ComboBox: " & strComboName Set cmb = frm.Controls(strComboName) ' التحقق من مصدر البيانات Call EnsureDictionary strKey = frm.Name & "." & cmb.Name If dictRowSources.Exists(strKey) Then strSourceSQL = dictRowSources(strKey) Else strSourceSQL = Trim(Replace(cmb.RowSource & "", ";", "")) ' إزالة الفاصلة المنقوطة ' Debug.Print "RowSource: " & strSourceSQL If Len(strSourceSQL) = 0 Then MsgBox "مصدر البيانات غير صالح.", vbExclamation Exit Sub End If dictRowSources.Add strKey, strSourceSQL End If ' إعادة تعيين المصدر إذا لم يتم توفير حقل تصفية If Len(strFilterField) = 0 Then If cmb.RowSource <> strSourceSQL Then cmb.RowSource = strSourceSQL End If cmb.Requery cmb.Dropdown strLastFilterValue = "" strLastComboName = strComboName Exit Sub End If ' التحقق من نوع عنصر التحكم النشط If TypeOf Screen.ActiveControl Is Access.TextBox Or TypeOf Screen.ActiveControl Is Access.ComboBox Then strFilterValue = Nz(Screen.ActiveControl.Text, vbNullString) ' Debug.Print "ActiveControl: " & Screen.ActiveControl.Name ' Debug.Print "FilterValue: " & strFilterValue Else ' Debug.Print "ActiveControl is not TextBox or ComboBox" If cmb.RowSource <> strSourceSQL Then cmb.RowSource = strSourceSQL End If cmb.Requery cmb.Dropdown strLastFilterValue = "" strLastComboName = strComboName Exit Sub End If ' إعادة تعيين المصدر إذا كانت القيمة المصفاة فارغة If Len(strFilterValue) = 0 Then If cmb.RowSource <> strSourceSQL Then cmb.RowSource = strSourceSQL End If cmb.Requery cmb.Dropdown strLastFilterValue = "" strLastComboName = strComboName Exit Sub End If ' التحقق مما إذا كانت القيمة المصفاة أو ComboBox قد تغيرت If strFilterValue = strLastFilterValue And strComboName = strLastComboName Then cmb.Requery cmb.Dropdown Exit Sub End If ' استخدام Regex لاستخراج ORDER BY Set objRegex = CreateObject("VBScript.RegExp") With objRegex .Global = True .IgnoreCase = True .Pattern = "\s*ORDER\s+BY\s+.*$" End With Set objMatches = objRegex.Execute(strSourceSQL) If objMatches.Count > 0 Then strOrderByClause = objMatches(0).Value strSourceSQL = Trim(Replace(strSourceSQL, strOrderByClause, "")) Else strOrderByClause = "" End If ' Debug.Print "SourceSQL: " & strSourceSQL ' Debug.Print "OrderBy: " & strOrderByClause ' التحقق من الحقول وإنشاء شرط WHERE لحقول متعددة If Len(strFilterField) > 0 Then arrFilterFields = Split(strFilterField, ",") strWhereClause = "" For i = LBound(arrFilterFields) To UBound(arrFilterFields) Dim strField As String strField = Trim(arrFilterFields(i)) If Len(strField) > 0 Then If Len(strWhereClause) > 0 Then strWhereClause = strWhereClause & " OR " strWhereClause = strWhereClause & strField & " LIKE '*" & Replace(strFilterValue, "'", "''") & "*'" End If Next i If Len(strWhereClause) = 0 Then MsgBox "تعبير التصفية غير صالح: " & strFilterField, vbExclamation Exit Sub End If On Error Resume Next strFilteredSQL = strSourceSQL & " WHERE (" & strWhereClause & ")" & strOrderByClause ' Debug.Print "FilteredSQL: " & strFilteredSQL cmb.RowSource = strFilteredSQL If Err.Number <> 0 Then MsgBox "تعبير التصفية غير صالح: " & strFilterField & vbCrLf & "Error: " & Err.Description, vbExclamation On Error GoTo ExitWithError Exit Sub End If On Error GoTo ExitWithError Else strFilteredSQL = strSourceSQL & strOrderByClause cmb.RowSource = strFilteredSQL End If ' تعيين المصدر المصفى وتحديث واجهة المستخدم cmb.Requery cmb.Dropdown strLastFilterValue = strFilterValue strLastComboName = strComboName Exit Sub ExitWithError: Select Case Err.Number Case 2118 Resume Next Case Else MsgBox "حدث خطأ أثناء التصفية: " & Err.Number & " | " & Err.Description, vbExclamation End Select End Sub الاستدعاء فى النموذج في حدث Click : لإعادة تحميل القائمة الأصلية لمربع السرد عند الضغط عليه ' في حدث Click Private Sub ComboBoxName_Click() FilterCombo Me, "ComboBoxName" End Sub وايضا في حدث KeyUp : لتصفية القيم أثناء الكتابة في مربع السرد حسب حقل واحد ' في حدث KeyUp Private Sub ComboBoxName_KeyUp(KeyCode As Integer, Shift As Integer) FilterCombo Me, "ComboBoxName", "FieldName" End Sub مع امكانية في حدث KeyUp : لتصفية القيم أثناء الكتابة في مربع السرد حسب أكثر من حقل ' في حدث KeyUp لعمل التصفية المتعددة Private Sub ComboBoxName_KeyUp(KeyCode As Integer, Shift As Integer) FilterCombo Me, "ComboBoxName", "FieldName, FieldName2" End Sub تحياتى Filter inside the Combobox.accdb

وعليكم السلام ورحمة الله وبركاته استخدم هذا المعادله واسحبها الي قدر ما تحتاج من الصفوف =CLEAN(TRIM(C2))

وعليكم السلام ورحمة الله وبركاته يمكنك استخدام المعادلة نم اسخبها للاسفل =TEXT(D7;"dd/mm/yyyy") تحويل التاريخ الى نص.xlsx

اعرض الملف أداة الترقيم التلقائي المخصص - مع مراعاة الأرقام المفقودة {سلسلة الأدوات المساعدة المخصصة} هذه الأداة تقوم بمهمتين في غاية الأهمية الأولى إمكانية إستخدام الأرقام المفقودة (المحذوفة) الثانية إمكانية الترقيم بحسب مجموعة أو فئة (كالترقيم بحسب السنة مثلاً) أعتقد أن الكثير منا سيحتاجها في وقت من الأوقات لذا من الجيد أن تكون متوفرة في ذلك الوقت تحياتي صاحب الملف منتصر الانسي تمت الاضافه 08/09/25 الاقسام قسم الأكسيس  

اعرض الملف أداة تصفية النموذج أثناء الكتابة على أساس أي حقل من حقول النموذج {سلسلة الأدوات المساعدة المخصصة} ستقوم هذه الأداة بتوفير كل الوقت الذي قد تضيعه في التفكير لطرق تصفية النماذج وستستغني بها عن كل الأكواد أو الأوامر الطويلة داخل كل نموذج للقيام بعملية التصفية وفقاً لكل حقل من حقول النموذج فكل ما ستحتاجه هو سطر واحد فقط وسيتم الأمر تحياتي صاحب الملف منتصر الانسي تمت الاضافه 08/09/25 الاقسام قسم الأكسيس  

تحديث واجهة الأداة بشكل جذري عن النسخة الأولى التجريبية 👍 توسيع الأداة لتشمل عدة تنسيقات إضافة الى التحويل من PDF إلى صور ، بحيث تم إضافة :- التحويل من صور إلى ملفات مستندات Word التحويل من صور إلى PDF ( العكس من الفكرة الرئيسية 😁 ) التحويل أيضاً من ملفات المستندات Word إلى ملفات PDF تجزئة وتقسيم ملفات الـPDF إلى صفحات ( كل صفحة في ملف منفصل ) الأداة الآن تعمل بميزة جديدة وهي السحب والإفلات ؛ وهذه صورة للجزء المنفذ لهذه الإضافة الجديدة . إمكانية اختيار مجلد الحفظ والإستخراج ، أو الاعتماد على المجلد( OutFolder ) الذي يتم انشاؤه عند فتح الأداة . 1️⃣ في قسم التحويل من الصور إلى مستندات Word ، تم تمكين المستخدم من :- تحديد اتجاه الصفحة ( رأسي - أفقي ) . تحديد الهوامش الأربعة كما في Word تماماً . تحديد حجم الورقة ( A3 , A4 , A5 , Letter , Legal ) . أيضاً تحديد محاذاة الصور في الورقة ( يمين - وسط - يسار ) . في الزر ، سيتم فتح واجهة لتعديل الإعدادات بشكلها التالي :- 2️⃣ في قسم التحويل الصور أو ملفات Word إلى PDF يتم التعامل مع الصور بضغطها وإزالة كافة إعدادات مايكروسوفت word لتقليل حجم الملف الناتج . 3️⃣ الأداة مستقلة وغير قابلة للدمج الداخلي في أي مشروع ، إلا من خلال الإستدعاء كأداة خارجية . ملف التحديث بالنسختين :- نسخة 64 :- Convert 64.zip نسخة 32 :- Convert 32.zip

أولا تم تعديل المعادلة لتكون: =IF(G2="";"";IF(G2<1;"أقل من فدان";IF(AND(G2>=1; G2<3);"من 1 إلى أقل من 3 فدان";IF(AND(G2>=3; G2<5);"من 3 إلى أقل من 5 فدان";IF(AND(G2>=5; G2<10);"من 5 إلى أقل من 10 فدان";IF(AND(G2>=10; G2<20);"من 10 إلى أقل من 20 فدان";IF(AND(G2>=20; G2<=25);"من 20 إلى 25 فدان";"أكثر من 25 فدان"))))))) شرح المعادلة: تستخدم الدالة IF بشكل متداخل لتصنيف قيمة موجودة في الخلية G إلى فئات مختلفة بناء على مدى هذه القيمة مع افتراض أن القيمة تمثل مساحة بالأفدنة تماما مثل إظهار نتيجة الطلاب بالتقديرات IF(G2="";"") إذا كانت الخلية G2 فارغة، فإن الناتج يكون فارغًا أيضا لا يعرض شيء. هذا يجنب ظهور نتائج غير مرغوبة عند عدم وجود بيانات. IF(G2<1;"أقل من فدان") إذا كانت القيمة في G2 أقل من 1 لكن ليست فارغة يعرض: "أقل من فدان". IF(AND(G2>=1; G2<3) إذا كانت القيمة أكبر من أو تساوي 1 ولكن أقل من 3 يعرض: "من 1 إلى أقل من 3 فدان". وهكذا باقي المساحات أما المعادلة =IF(AND(ISNUMBER(D2); ISNUMBER(E2); ISNUMBER(F2)); F2 + E2/24 + D2/576; "") تستخدم لتحويل وحدات الأراضي (الفدان، القيراط، السهم) إلى قيمة عشرية واحدة تعبر عن المساحة الكلية بالفدان. الوحدات المستخدمة في مصر: الفدان (F2) ← الوحدة الأساسية. القيراط (E2) ← 1 فدان = 24 قيراط. السهم (D2) ← 1 قيراط = 24 سهم → إذن 1 فدان = 576 سهم (24 × 24) ثانيا: ملفك الأصلي فيه بعض الملاحظات فهناك صفوف فارغة تماما و أيضا الخلايا فارغة ليس بها أي رقم المفروض نضع صفر في الخلايا الفارغة لتدخل ضمن حساب المعادلة أيضا هناك أسماء لا تملك حتى سهم و بالتالي لا تدخل ضمن الأفراد ذوي الملكية بعد التعديلات ستلاحظ أن العدد مضبوط فئات الانتفاع2.xlsx

تفضل جرب ..... كشف الحضور.accdb

تفضل الملف بعد اجراء التحسينات اللازمة عليه مثل اضافة قائمة منسدلة لاختيار تم أو لم يسدد ثم عمل كود لترحيل البيانات لورقتي عمل الحساب.xlsm

السلام عليكم فعلا طريقة الملف غير مجدية لأنه اصبح ثقيلاا بفعل المعادلات أخي : الملف مليئ بالمعادلات وكونك الآن لا يمكن ان تحوله إلى الأكواد بسرعة (كونها اخف في الحجم) فقط عملت لك حلا سريعا أرجو أن يناسبك أشتغل على الملف كما كنت تعمل عليه من قبل ولكن الملف الآن لن يحسب لك المطلوب مباشرة فعندما تنهي عملك تماما قم بالحفظ وبعدها سيتم حساب الخلايا في الملف ما قمت به أنا باختصار هو : تحول الحساب التلفائي إلى يدوي ويعمل فقط عند حفظ الملف تفضل تسهيل رصد فورى 1.xlsm

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

وعليكم السلام ورحمة الله تعالى وبركاته جرب إفراغ اليوزرفورم من جميع الأكواد السابقة ولصق الكود التالي ربما يناسبك Option Explicit Public Property Get WS() As Worksheet: Set WS = Sheets("RECAP MDN+DGSN"): End Property Private Sub CommandButton1_Click() Const MAX_DAYS As Long = 90 Dim a As Variant, matricule As String, xDate As Date, lastDate As Date Dim i As Long, tmp As Long, trouve As Boolean, jRestants As Long matricule = Trim(Me.TextBox2.Value) If matricule = "" Then MsgBox "المرجو إدخال رقم التسجيل", vbExclamation, "تنبيه": Exit Sub If Not IsDate(Me.TextBox3.Value) Then MsgBox "المرجو إدخال التاريخ", vbExclamation, "خطأ": Exit Sub xDate = CDate(Me.TextBox3.Value): a = WS.Range("B8:C22").Value For i = UBound(a, 1) To 1 Step -1 If Trim(a(i, 1)) = matricule And IsDate(a(i, 2)) Then lastDate = a(i, 2): trouve = True: Exit For Next i If trouve And xDate - lastDate < MAX_DAYS Then jRestants = MAX_DAYS - (xDate - lastDate) MsgBox "يوجد تسجيل سابق بتاريخ: " & Format(lastDate, "dd/mm/yyyy") & vbCrLf & _ "يرجى الانتظار " & jRestants & " يوم قبل التسجيل مجددا", vbExclamation, "تنبيه" Exit Sub End If For i = 1 To UBound(a, 1) If Trim(a(i, 1)) = "" Then tmp = i: Exit For Next i If tmp = 0 Then MsgBox "النطاق ممتلئ لا يمكن إضافة تسجيل جديد", vbCritical, "خطأ": Exit Sub a(tmp, 1) = matricule: a(tmp, 2) = xDate WS.Range("B8:C22").Value = a MsgBox "تمت إضافة التسجيل بنجاح", vbInformation Me.TextBox2.Value = "": Me.TextBox3.Value = "" End Sub '==================== Private Sub CommandButton4_Click() Dim OnRng As Variant, matricule As String, tmps As Date Dim i As Long, supprimé As Boolean matricule = Trim(Me.TextBox2.Value) If matricule = "" Then MsgBox "المرجو إدخال رقم التسجيل لحذفه", vbExclamation, "تنبيه": Exit Sub If Not IsDate(Me.TextBox3.Value) Then MsgBox "المرجو إدخال التاريخ", vbExclamation, "خطأ": Exit Sub tmps = CDate(Me.TextBox3.Value) If MsgBox("هل أنت متأكد من حذف هذا التسجيل؟" & vbCrLf & _ "رقم التسجيل: " & matricule & vbCrLf & _ "تاريخ التسجيل: " & Format(tmps, "dd/mm/yyyy"), _ vbYesNo + vbQuestion, "تأكيد الحذف") = vbNo Then Exit Sub OnRng = WS.Range("B8:C22").Value supprimé = False For i = 1 To UBound(OnRng, 1) If Trim(OnRng(i, 1)) = matricule And IsDate(OnRng(i, 2)) And CDate(OnRng(i, 2)) = tmps Then OnRng(i, 1) = "": OnRng(i, 2) = "": supprimé = True: Exit For End If Next i If supprimé Then WS.Range("B8:C22").Value = OnRng MsgBox "تم حذف التسجيل بنجاح", vbInformation Else MsgBox "لم يتم العثور على التسجيل المطلوب", vbExclamation, "غير موجود" End If Me.TextBox2.Value = "": Me.TextBox3.Value = "" End Sub Castrole v2.xlsm

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

ممكن يكون من إعدادت اللغة فتح: لوحة التحكم > المنطقة (Region) > الإدارة (Administrative) اضغط: تغيير الإعدادات المحلية للنظام (Change system locale...) اختر: العربية (Egypt) أو العربية (Saudi Arabia) حسب منطقتك. أعد تشغيل الجهاز.

و عليكم السلام جرب الملف الرقم السري 1234 كود إخفاء واظهار شيتات محددة برقم سري والباقي ظهار 2.xlsm

تفضل الملف و جرب كتابة اسماء بها عبد في العمود الثالث و طبق عليها ما تريد حذف المسافات(1).xlsm

الموضوع قديم يعود لــــ 2011 وقد عرض اخوي الاستاذ فادي الرابط بالامس في احدى مشاركاته .. وحين دخلت الموضوع .. ونزلت المرفق وجدت فيه مشكلة عند الفتح لذا قمت بتجديد المرفق Reserved words in Access.rar

وعليكم السلام ورخمة الله وبركاته جرب هذا الكود Sub MergeSheets_Total() Dim ws As Worksheet, wsTotal As Worksheet Dim i As Long, destRow As Long Dim dateValue As Variant Dim r As Long, lastDataRow As Long Dim sheetName As String On Error Resume Next Set wsTotal = ThisWorkbook.Sheets("TOTAL") On Error GoTo 0 If wsTotal Is Nothing Then MsgBox "لم يتم العثور على الشيت TOTAL", vbCritical Exit Sub End If Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Application.EnableEvents = False wsTotal.Range("A3:F320").ClearContents destRow = 3 For i = 1 To 31 sheetName = Format(i, "00") On Error Resume Next Set ws = ThisWorkbook.Sheets(sheetName) On Error GoTo 0 If Not ws Is Nothing Then lastDataRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row If lastDataRow >= 4 Then dateValue = ws.Range("B1").Value For r = 4 To lastDataRow If Trim(ws.Cells(r, "A").Value) <> "" Then wsTotal.Cells(destRow, "B").Resize(1, 5).Value = ws.Cells(r, "A").Resize(1, 5).Value wsTotal.Cells(destRow, "A").Value = dateValue destRow = destRow + 1 End If Next r End If End If Set ws = Nothing Next i Application.EnableEvents = True Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True End Sub The Safe1.xlsb

السلام عليكم برنامج مبيعات ./. برنامج حركات مالية كيف يتم هذا ؟ يجب علينا تصور وتخيل العملية اين محل الصناديق والبنك في جدول البيع والشراء ؟ هل يتم رصد اسم الصندوق في جدول المبيعات عند حركة البيع؟ حتى يفهم منه ان المال دخل الى الصندوق الفلاني ام انه يتم ايداع أو صرف وتحويل المبالغ بعمليات وجداول مستقلة ؟ اذا صحيح .. فجداول المبيعات لا محل لها من الاعراب هنا عرض جميل ومثال اجمل لدي ملاحظة بل اثنتان 1- ما اقتبسته اعلاه ليس له محل في جداول العمليات المالية .. الا ان قصدت بالخصم ما يتم داخل الاستعلامات 2- رأيي ان نضم البنوك الى الصناديق في جدول واحد .. وفي جدول الحركة يكفي حقلان (من / الى) واللذان يمثلان المعرف

أخواني وأساتذتي ومعلمينا ( دون استثناء ) أداة بسيطة - مفتوحة المصدر - مشتقة من أداة مرسال والواتس أب 2025 في هذا الموضوع هنا ، لفحص حالة الرقم من انه مسجل على الواتس اب أم لا ، تعتمد على تطبيق واتس أب سطح المكتب . يمكن تطويرها داخل المشاريع لتتلائم مع متطلبات مشروعك . فقط اكتب الرقم مع المفتاح الدولي ، وسيتم فتح التطبيق والكشف مما إذا كان مسجلاً على الواتس أب أم لا . طبعاً الأداة ستعتمد على قراءة رسالة الواتس أب التالية ، وهنا اللغز في الموضوع . صورة واجهة الأداة :- تم إضافة ميزة جديدة وهي ، الفحص لجدول يحتوي على ارقام مخزنة ليتم الفحص الكامل على مجموعة من الأرقام بدلاً من رقم واحد . حيث تم انشاء جدول يضم حقل الرقم وحقل الحالة وحقل تاريخ التحقق وحقل ملاحظات . Check Number 1.1.zip

تفضل ترحيل بيانات.xlsm

اشكرك من قلبى يا صديقى والان اقدم المرفقات النهائية لكم - مرفق توليد كلمات المرور للمبرمجين - مرفق العملاء تفعيل بمدة محددة.zip

مش عارف الحل ده ممكن واللا لا انا اساسا مش عارف اذا كنت اساسا فهمت المطلوب Private Sub mjal_AfterUpdate() Dim strSQL As String ' تحديد مصدر السرد بناء على الاختيار Select Case Me.mjal.Column(1) Case "فردي1", "فردي2" ' إخفاء "زوجي" strSQL = "SELECT ac_id, ac_Name FROM tbl_Mjal WHERE ac_Name NOT IN ('زوجي')" Case "زوجي" ' إخفاء "فردي1" و"فردي2" strSQL = "SELECT ac_id, ac_Name FROM tbl_Mjal WHERE ac_Name NOT IN ('فردي1', 'فردي2')" Case Else ' إظهار جميع الخيارات strSQL = "SELECT ac_id, ac_Name FROM tbl_Mjal" End Select ' تحديث مصدر مربع السرد Me.mjal.RowSource = strSQL Me.mjal.Requery End Sub Private Sub Form_Load() ' تعيين مصدر السرد الافتراضي عند تحميل النموذج Me.mjal.RowSource = "SELECT ac_id, ac_Name FROM tbl_Mjal" Me.mjal.Requery End Sub المرفق Database2.accdb

الأخوة أعضاء وزوار هذا الصرح العظيم السلام عليكم ورحمة الله وبركاته اقدم لكم ملف مواقيت الصلاة لعدد 9 مدن من مدن المملكة أتمني ينال إعجابكم مواقيت الصلاة.xlsm

تقضلوم الملف بالمعادلات المتوافقة مع الاصدارات القديمة لأكسيل و ابت الملف بدون أكواد مع أن الأكواد افضل لأنها تى و إن اضفت صفحات لأشهر جديدة فان الكود سيرحل البيانات تلقائيا . على العموم ابتعدت عن دالة فلتر التي تستخدم في اكسيل 2019 فما فوق 3الحساب.xlsx

الآن انت تصارع من اجل ادخال البيانات لا يهم مسألة طريقة الادخال مهما كانت معقدة .. بقدر أهمية التصميم الصحيح للجداول المبرمج الناجح الذي يعمل ويستمتع همه الأكبر صحة التأسيس . لأن خلفها تبعات : استعلامات وتقارير الـ 500 موظف الم يخطر ببالك ادخال تقييمهم جميعا بضغطة زر واحدة ( طبعا حسب فكرتك بوجود قيم افتراضية)؟ ثم بعدها ترجع لمن هو بحاجة الى تعديل ؟

السلام عليكم مرفق لك الملف حسب ما فهمت منك اتمنى يكون المطلوب الحساب.xlsm

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

وعليكم السلام ورحمة الله وبركاته الملف المرفق بالمعادلات به كل ما يخص الرقم القومي و حساب السن لطلبة المدارس حساب السن بالرقم القومي.xlsx

عليكم السلام هل هذه حزورة ؟؟ كيف تريد التعديل على الكود .. مع عدم التغيير ؟ اذا انت تقصد الابقاء على استخدام Me.Filter في التصفية .. يمكن السؤال يكون على النحو التالي : اريد تصفية البيانات بناء على الاختيار من مربعي التحرير باستخدام Me.Filter

دوال API سوف تحتاج لمعالجة خاصة مع كلتا النواتان عند كتابة الكود ان اردت التطبيق يعمل مع اى منهما نركز شوية يا فؤش أفندى من فضلك الخلاصة سياسة مايكروسوفت الرسمية مايكروسوفت تنصح باستخدام Office 64-بت فقط إذا: تتعامل مع ملفات ضخمة جدا (ملفات Excel أو Power BI) لديك RAM أكثر من 4GB وتحتاج الاستفادة منها بالكامل أما بالنسبة لـ Access فتوصي مايكروسوفت بـ Office 32-بت إذا كنت: تستخدم قواعد بيانات قديمة أو إضافات COM تعتمد على ActiveX أو كائنات VB6 وعلشان محدش يدخل بعد كده يقول لى انت جايب الكلام ده منين : من هنا رابط سياسية مايكروسوفت فى اختيار الانوية وملخص المقال كلاتى : متى تختار Office 64‑بت: إذا كنت تتعامل مع ملفات كبيرة جدا مثل Excel تتعدى 2 GB أو تستخدم Power Pivo - Power BI أو صور وفيديوهات ضخمة في PowerPoint جهازك يحتوي على ذاكرة RAM أكبر من 4 GB وتريد الاستفادة من السعة الكاملة لذاكرة الوصول هذا النوع من الاستخدام يستفيد من قدرة 64 بت على الوصول إلى مساحة عناوين كبيرة جدا (حتى تيرابايت) متى تختار Office 32‑بت: لديك إضافات COM اذن لابد من استخدام 32 بت أو مكتبات ActiveX قديمة لا تتوفر بنسخة 64 بت تستخدم ملفات Access تم ( تشفيرها ) إنشاؤها مسبقا بصيغة mde أو accde بصيغة 32 بت تعتمد في كودك على دوال Windows API أو وحدات Declare غير متوافقة مع 64 بت إلا بعد تعديل (PtrSafe و LongPtr) في هذه الحالات يظل الإصدار 32 بت هو الخيار الأكثر موثوقية واستقرارية -------------------------------------------------- الأفضل غالبا بالنسبة للتعامل مع قواعد بيانات الاكسس وهذا رأى انا الشخصى : 64 بت الأسباب: أكثر توافقا مع الأنظمة الحديثة (ويندوز 64 بت – وهو الغالب حاليا) أداء أفضل عند التعامل مع ملفات Excel أو ملفات Access ضخمة جدا (خاصة عند استخدام استعلامات خارجية أو روابط) أفضل دعم أمني على مستوى النظام (بسبب استبعاد مكتبات 32 بت القديمة غير الآمنة) استقرار أكبر على أنظمة حديثة تستخدم Office 64 بت بشكل كامل ولكن: إذا كنت تستخدم أحد التالي: مكتبات DAO/ADO قديمة ملفات ACCDE/OCX مبنية على 32بت إضافات مثل شجرة TreeView أو Mscomctl.ocx تعليمات API بدون PtrSafe الأفضل: 32 بت لأنك ستتجنب مشاكل التوافق وإعادة كتابة أو تعديل الكود لكن كمطور قواعد بيانات أكسس : بغض النظر عن النواة أفضل ممارسة هي كتابة الكود بصيغة متوافقة مع النواتين (باستخدام If VBA7 Then- PtrSafe- LongPtr# وغيرها حسب وضع الكود) بحيث تعمل برامجك على أي بيئة دون مشاكل مستقبلية

السلام عليكم ورحمة الله وبركاته سوف أقدم وحدة نمطية عامة متقدمة تتيح لك فتح أي تقرير في الاكسس بطريقة ديناميكية مع التحقق من وجود التقرير ومصدر بياناته واحتوائه على بيانات قبل العرض أو الطباعة الخصائص والمميزات تحقق تلقائي من وجود التقرير قبل عرضه دعم التصفية من خلال تمرير شروط WhereCondition لتحديد البيانات ادارة المصدر وذلك من خلال استخراج RecordSource بشكل ديناميكي مع التخزين المؤقت داخل قاموس مرونة التعامل مع اوضاع التقارير المختلفه بحيث يدعم الطباعة - المعاينة - او اى وضع عرض الصمت المطلق للاستخدامات البرمجية من خلال اختيار تفعيل الوضع "بدون رسائل" للاستخدام البرمجى عند الحاجة بدون ازعاج استجابة ذكية ومعالجة اخطاء احترافية من خلال تعامل متكامل مع الأخطاء الشائعة تقريبا طريقة الدمج في مشاريعك و قواعد بياناتك : ضع الكود فى وحدة نمطية عامة مثلا باسم : basReportUtils استدعِ الدالة OpenReportSmart كما يناسب سيناريو العرض الذى تفضلة او المعالحة التى ترغب بها يمكن تمرير المعلمات بسهولة أو الاعتماد على القيم الافتراضية المستخدمة فى التكويد وأخيرا الكود المستخدم داخل الوحدة النمطية : basReportUtils ' __ ' / /\ ' / / \www.officena.net™ ' / / \__________ ' / / \ /\ ' /_/ \ / / ' ___\ \ ___\____/_/_ ' /____\ \ /___________/\ ' \ \ \ \ \ \ ' \ \ \ \____ \ \ ' \ \ \ / /\ \ \ ' \ / \_\/ / / \ \ ' \ / / /__________\/ ' / / / / ' /ابو جودى/ / / ' /________/ /\ / 21/07/2025 ' \________\/\ \ / منتديات أوفيسنا عالم من الابداع ' \_\/_____________________________________ Option Compare Database Option Explicit '' ==== متغير خاص لتخزين مؤقت لمصادر البيانات ==== ' --- Dictionary لتخزين RecordSource للتقارير Private m_dictRecordSource As Object '' ==== دالة: التحقق من وجود تقرير داخل قاعدة البيانات ==== Private Function ReportExists(ByVal strReportName As String) As Boolean On Error Resume Next ReportExists = Not CurrentProject.AllReports(strReportName) Is Nothing On Error GoTo 0 End Function '' ==== دالة: الحصول على مصدر البيانات لتقرير معين مع تخزين مؤقت ==== Private Function GetRecordSource(ByVal strReportName As String) As String If m_dictRecordSource Is Nothing Then Set m_dictRecordSource = CreateObject("Scripting.Dictionary") End If If m_dictRecordSource.Exists(strReportName) Then GetRecordSource = m_dictRecordSource(strReportName) Exit Function End If On Error GoTo ErrHandler DoCmd.OpenReport strReportName, acDesign, , , acHidden GetRecordSource = Trim(Reports(strReportName).RecordSource) DoCmd.Close acReport, strReportName, acSaveNo m_dictRecordSource.Add strReportName, GetRecordSource Exit Function ErrHandler: GetRecordSource = "" End Function '' ==== دالة: التحقق من احتواء التقرير على بيانات ==== Private Function ReportHasData(ByVal strReportName As String, ByVal strRecordSource As String, _ Optional ByVal strWhereCondition As String = "", _ Optional ByVal strOpenArgs As String = "") As Boolean Dim dbs As DAO.Database Dim rst As DAO.Recordset Dim qdf As DAO.QueryDef Dim lngCount As Long Dim bolIsQuery As Boolean On Error GoTo ErrHandler Set dbs = CurrentDb ''---- التحقق مما إذا كان strRecordSource يشير إلى استعلام محفوظ On Error Resume Next Set qdf = dbs.QueryDefs(strRecordSource) If Err.Number = 0 Then bolIsQuery = True Else Err.Clear bolIsQuery = False End If On Error GoTo ErrHandler ''---- محاولة حساب عدد السجلات If bolIsQuery Or InStr(1, strRecordSource, "SELECT", vbTextCompare) = 1 Then On Error Resume Next If bolIsQuery Then ''---- إذا كان استعلامًا محفوظًا، تحقق من المعلمات If qdf.Parameters.Count > 0 Then ReportHasData = False ' لا يمكن معالجة معلمات بدون قيم GoTo CleanUp End If Set rst = qdf.OpenRecordset(dbOpenSnapshot, dbReadOnly) Else ''---- إنشاء استعلام مؤقت مع strWhereCondition Dim strSQL As String strSQL = strRecordSource If Len(strWhereCondition) > 0 Then strSQL = strSQL & " WHERE " & strWhereCondition End If Set rst = dbs.OpenRecordset(strSQL, dbOpenSnapshot, dbReadOnly) End If If Err.Number = 0 Then lngCount = IIf(rst.EOF, 0, rst.RecordCount) rst.Close Set rst = Nothing Else Err.Clear lngCount = 0 End If On Error GoTo ErrHandler Else On Error Resume Next lngCount = Nz(DCount("*", strRecordSource, strWhereCondition), 0) If Err.Number <> 0 Then Err.Clear lngCount = 0 End If On Error GoTo ErrHandler End If ''---- إذا لم يكن هناك سجلات، تحقق من HasData If lngCount = 0 Then On Error Resume Next DoCmd.OpenReport strReportName, acViewPreview, , strWhereCondition, acHidden, strOpenArgs If Err.Number = 0 Then ReportHasData = Reports(strReportName).HasData DoCmd.Close acReport, strReportName, acSaveNo Else Err.Clear ReportHasData = False End If On Error GoTo ErrHandler Else ReportHasData = True End If CleanUp: If Not rst Is Nothing Then rst.Close Set rst = Nothing End If If Not qdf Is Nothing Then Set qdf = Nothing End If Set dbs = Nothing Exit Function ErrHandler: ReportHasData = False GoTo CleanUp End Function '' ==== إجراء عام: عرض تقرير بعد التحقق من وجوده واحتوائه على بيانات من وجود بيانات وطلب تأكيد الطباعة ==== Public Sub OpenReportSmart(ByVal strReportName As String, _ Optional ByVal bolAskToPrint As Boolean = True, _ Optional ByVal strViewMode As AcView = acViewNormal, _ Optional ByVal strWhereCondition As String = "", _ Optional ByVal strOpenArgs As String = "", _ Optional ByVal bolSilent As Boolean = False) Const strTitleConfirm As String = "تأكيد الطباعة" Const strTitleAlert As String = "تنبيه" Const strTitleError As String = "خطأ" Dim strRecordSource As String On Error GoTo ErrHandler ''---- التحقق من وجود التقرير If Not ReportExists(strReportName) Then If Not bolSilent Then MsgBox "التقرير '" & strReportName & "' غير موجود.", vbExclamation + vbMsgBoxRight + vbMsgBoxRtlReading, strTitleAlert End If Exit Sub End If ''---- الحصول على مصدر البيانات strRecordSource = GetRecordSource(strReportName) If Nz(strRecordSource, "") = "" Then If Not bolSilent Then MsgBox "التقرير '" & strReportName & "' لا يحتوي على مصدر بيانات.", vbExclamation + vbMsgBoxRight + vbMsgBoxRtlReading, strTitleAlert End If Exit Sub End If ''---- التحقق من وجود بيانات If Not ReportHasData(strReportName, strRecordSource, strWhereCondition, strOpenArgs) Then If Not bolSilent Then MsgBox "التقرير '" & strReportName & "' لا يحتوي على بيانات.", vbExclamation + vbMsgBoxRight + vbMsgBoxRtlReading, strTitleAlert End If Exit Sub End If ''---- طلب تأكيد الطباعة If bolAskToPrint And Not bolSilent Then If MsgBox("هل تريد طباعة التقرير '" & strReportName & "'؟", vbYesNo + vbQuestion + vbMsgBoxRight + vbMsgBoxRtlReading, strTitleConfirm) = vbNo Then Exit Sub End If End If ''---- فتح التقرير DoCmd.OpenReport strReportName, strViewMode, , strWhereCondition, acWindowNormal, strOpenArgs CleanUp: Exit Sub ErrHandler: Select Case Err.Number Case 2501 ''---- تم إلغاء العملية Case 2212 If Not bolSilent Then MsgBox "تم إلغاء عملية الطباعة أو تعذر العثور على التقرير '" & strReportName & "'.", _ vbExclamation + vbMsgBoxRight + vbMsgBoxRtlReading, strTitleAlert End If Case Else If Not bolSilent Then MsgBox "حدث خطأ أثناء فتح التقرير '" & strReportName & "'!" & vbCrLf & _ "رقم الخطأ: " & Err.Number & vbCrLf & _ "الوصف: " & Err.Description, vbCritical + vbMsgBoxRight + vbMsgBoxRtlReading, strTitleError End If End Select GoTo CleanUp End Sub وفى هذا الجزء استعرض بعض الامثلة لطرق الاستدعاء واستخدام الكود ' ====== (OpenReportSmart) طرق استدعاء الإجراء الرئيسي ====== '' 01 --- أبسط استدعاء بدون معلمات إضافية '' --- يعرض التقرير rptEmployees في الوضع الافتراضي للطباعة، مع تأكيد وظهور الرسائل Call OpenReportSmart("rptEmployees") '' 02 --- استدعاء بدون تأكيد '' --- يعرض التقرير بدون سؤال المستخدم عن التأكيد قبل الطباعة Call OpenReportSmart("rptEmployees", False) '' 03 --- فتح التقرير في وضع المعاينة Preview '' --- يفتح التقرير في وضع المعاينة، مع تأكيد قبل العرض Call OpenReportSmart("rptEmployees", True, acViewPreview) '' 04 --- تمرير شرط تصفية Where '' --- عرض التقرير فقط للموظفين في قسم معين Call OpenReportSmart("rptEmployees", True, acViewPreview, "DepartmentID = 5") '' 05 --- تمرير بيانات عبر OpenArgs '' --- يستخدم OpenArgs داخل التقرير لتخصيص العرض Call OpenReportSmart("rptEmployees", True, acViewPreview, , "ShowSummary") '' 06 --- الوضع الصامت (لا يظهر أي رسائل) '' --- يفترض صحة كل شيء، ولا يعرض أي تنبيهات للمستخدم Call OpenReportSmart("rptEmployees", , , , , True) '' 07 --- مثال كامل بجميع المعاملات '' --- عرض بالتصفية، ووسائط OpenArgs، مع تأكيد، بدون صمت Call OpenReportSmart("rptEmployees", True, acViewPreview, "IsActive = True", "FromMainMenu", False) '' 08 --- مثال طباعة تقرير بناءً على اختيار موظف من نموذج Public Sub Example5_PrintReportWithDynamicFilter() ' ' --- التحقق من تحميل نموذج اختيار الموظف If CurrentProject.AllForms("frmEmployeeSelector").IsLoaded Then Dim strFilter As String strFilter = "EmployeeID = " & Forms!frmEmployeeSelector!cboEmployeeID Call OpenReportSmart("rptEmployeeAttendance", True, acViewNormal, strFilter) Else MsgBox "يرجى فتح نموذج اختيار الموظف أولاً.", _ vbExclamation + vbMsgBoxRight + vbMsgBoxRtlReading, "تنبيه" End If End Sub '' 09 --- معاينة تقرير ليوم محدد (تاريخ اليوم) Public Sub Example6_PreviewReportWithDateFilter() Dim strFilter As String strFilter = "ReportDate = #" & Format(Date, "mm/dd/yyyy") & "#" Call OpenReportSmart("rptDailySummary", True, acViewPreview, strFilter) End Sub '' 10 --- استدعاء التقرير باستخدام متغير شرط بتنسيقات مختلفة (نصي، رقمي، تاريخي) '' --- المثال الاساسى Call OpenReportSmart("rptEmployees", True, acViewPreview, "DepartmentID = 5") ''>>--> رقمي (رقم قسم مثلاً) Public Sub Example_NumericFilter() Dim lngDepartmentID As Long lngDepartmentID = 5 Dim strFilter As String strFilter = "DepartmentID = " & lngDepartmentID Call OpenReportSmart("rptEmployees", True, acViewPreview, strFilter) End Sub ''>>--> نصي (اسم الموظف مثلاً) Public Sub Example_TextFilter() Dim strEmployeeName As String strEmployeeName = "محمد علي" Dim strFilter As String strFilter = "EmployeeName = '" & strEmployeeName & "'" Call OpenReportSmart("rptEmployees", True, acViewPreview, strFilter) End Sub ''>>--> تاريخ (بيانات ليوم معين) Public Sub Example_DateFilter() Dim datTargetDate As Date datTargetDate = DateSerial(2025, 7, 1) Dim strFilter As String strFilter = "HireDate = #" & Format(datTargetDate, "mm/dd/yyyy") & "#" Call OpenReportSmart("rptEmployees", True, acViewPreview, strFilter) End Sub ' ======================= استخدام المعايير حسب انواع البيانات ======================= '>>--> رقمي-----Long / Integer : "FieldName = " & Numeric '>>--> نصي----String : "FieldName = '" & النص & "'" '>>--> تاريخ----Date : "FieldName = #" & Format(date, "mm/dd/yyyy") & "#" ' ===================================================================================== ولكن وجب التنويه الى شئ : الأكواد قيد التجربـــة أنا لسه كاتب الاكواد بناء على سؤال فى المنتدى

تفضل ملف محدث به كل ما طلبت أما بخصوص تعلم الأكواد فالموضوع بسيط و لكن يلزمه شغف التعلم مع المحاولة و الخطأ أجازات 3.xlsm

Private Sub UserForm_Initialize() Me.TextBox3.Value = Format(Date, "dd/mm/yyyy") Me.TextBox3.Locked = True Me.TextBox2.Value = "" End Sub Castrole v3.xlsm

تفضل الملف جاهز طرح الأيام =DATEDIF(R16;O16;"MD") طرح الشهور =DATEDIF(R16;O16;"YM") طرح السنوات =DATEDIF(R16;O16;"Y") لجمع السنوات =DATE(YEAR(O28) + T28; MONTH(O28) + S28; DAY(O28) + R28) جمع (2).xlsx

يجب إضافة المرجع Microsoft Office 16.0 Object Library كما بالصور أدناه من قائمة Tools إختر References انزل إلى أن تصل للمرجع Microsoft Office 16.0 Object Library (القائمة مرتبة أبجديا وسيكون الوصول للمرجع سهل) قم بتحديده واتقر OK تحياتي

مثال الاخ @Foksh النموذج Eye1 رائع خصوصا بعد تعديل الأخت @hanan_ms حيث أصبحت حركة العين أكثر سلاسة عند تحريك الماوس أما النموذج الخاص بالأخت @hanan_ms الذي بإسم Eye2 كلما احرك الماوس عليه تظهر لي رسالة الخطأ الموضحة بالصورة فهل تظهر الرسالة عند البقية أم أنها مشكلة خاصة بي فقط تحياتي

سبقتني في الإستكمال ، وهي لك لأني كنت على وشك ارفاق الصورة التالية أيضاً أخي @Barna 😅

وعليكم السلام ورحمة الله وبركاته .. من جهة قد يكون الأمر صعباً . لكن من خلال خدمات Google Cloud Console ، وتوظيف الـ API بشكل جيد يمكن الحصول على النتيجة القريبة من الطلب الذي تريده . كنت قد توجهت الى استخدام خدمات Google API في عدة مشاريع، قد تجد منها متوفراً في توقيعي نهاية هذه المشاركة ..

بشارك محاوله لاستاذ @ابو جودي ❤️🌹☕ لعبت بكود @Foksh تحميل المرفق https://www.mediafire.com/file/ljc1tzl04v3dcch/Eye+Ms_hanan.rar/file