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

أخواني وأساتذتي ومعلمينا ( دون استثناء ) أقدم لكم هدية بسيطة . وهي أداة لتحويل ملفات الـ 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

في هذه المشاركة سأحاول أن اشارك حضراتكم بعض المحاضرات و الدروس التي يلقيها خبراء عالميين في مجال الاكسيس المحاضرة الاولي : Access Add-in Helper with Geoffrey L. Griffith

السلام عليكم ورحمة الله أشارك معكم اليوم أكواد داخل وحدة نمطية عامة تم تطويرها لتصفية محتويات أي مربع سرد (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

وهذه طريقتي .. في محاولة لقبض العصى من المنتصف أيضا 😇🌼 بكود من سطر واحد .. واستخدام التنسيق الشرطي .. BlockExam_Moosak.accdb

أيضاً كإضافة عن الإستعلام السابق .. جرب هذا الإستعلام أيضاً لإنشاء جدول جديد ، واضافة القيم فيه بعد فصلها .. SELECT maal, IIF(IsNumeric(Left(Trim(maal), 1)) = True, Trim(Left(Trim(maal), InStr(Trim(maal) & " ", " ") - 1)), Trim(Mid(Trim(maal), InStr(Trim(maal), " ") + 1)) ) AS الرقم, IIF(IsNumeric(Left(Trim(maal), 1)) = True, Trim(Mid(Trim(maal), InStr(Trim(maal), " ") + 1)), Trim(Left(Trim(maal), InStr(Trim(maal) & " ", " ") - 1)) ) AS الاسم INTO TAGE_F FROM TAGE WHERE maal Is Not Null;

وهاتان دالتان كتبتهم من زمان 🙂🌷 : *دالة تفصل الأرقام عن الحروف ودالة تفصل الحروف عن الأرقام* *شرح الكود:* الدالة تستخرج الأرقام من جمله تحتوي على أرقام وحروف .. مثال1 : " أسماء الله 99 أسما " - النتيجة: 99 مثال2 : " أسماء الله 99 أسما " - النتيجة: أسماء الله أسما *الكود:* '==========================================(لاستخراج الأرقام فقط من النص) Public Function ExtractNumbersFromText(strText As String) Dim x As Long Dim L As String Dim r As String For x = 1 To Len(strText) L = Mid(strText, x, 1) If IsNumeric(L) Then r = r & L End If Next x ExtractNumbersFromText = Trim(r) End Function '==========================================(ولإزالة الأرقام من النص والإبقاء على الحروف فقط) Public Function RemoveNumbersFromText(strText As String) Dim x As Long Dim L As String Dim r As String For x = 1 To Len(strText) L = Mid(strText, x, 1) If Not IsNumeric(L) Then r = r & L End If Next x RemoveNumbersFromText = Trim(r) End Function *طريقة الاستدعاء (الاستخدام):* ExtractNumbersFromText("Your text with 123456 Here") RemoveNumbersFromText("Your text with 123456 Here") *مكتبة الأكواد*

لفصل الحروف والارقام داخل الاستعلام انت بحاجة الى دالة مثل هذه 'فصل الحروف Public Function textNum(fildHrfRqm As String) Dim lets, lets2, lets3 Dim i, r As Integer r = Len(fildHrfRqm) For i = 1 To r lets = Mid(fildHrfRqm, i, 1) If IsNumeric(lets) Then Else lets3 = lets3 & lets End If Next textNum = lets3 End Function 'فصل الارقام Public Function Numtext(fildHrfRqm As String) Dim lets, lets2, lets3 Dim i, r As Integer r = Len(fildHrfRqm) For i = 1 To r lets = Mid(fildHrfRqm, i, 1) If IsNumeric(lets) Then lets2 = lets2 & lets End If Next Numtext = lets2 End Function ولإنشاء جدول جديد يمكنك استخدام الاستعلام نفسه انظر المرفق فصل الحروف عن الارقام دالة2 .rar

الحمد لله توصلت لبعض الاكواد الرائعة ولتعميم الافادة إليكم الملف وبه 7 اكواد للنسخ وللنقل ومع الحفاظ على التنسيق وبدونه وايضا اضافة شرط رابع مع الحفاظ على ما تم نقله Book1 (1).rar

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

تفضل الملف و جرب كتابة اسماء بها عبد في العمود الثالث و طبق عليها ما تريد حذف المسافات(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- رأيي ان نضم البنوك الى الصناديق في جدول واحد .. وفي جدول الحركة يكفي حقلان (من / الى) واللذان يمثلان المعرف

السلام عليكم ورحمة الله تعالى وبركاته الجواب يبان من العنوان احدى طبقات الحماية لمن يهتم بذلك منظر ارائكم بعد التجربة.. ولكن بصراحة الكود مكتوب برخامة وهذا شئ مقصود و للتجربة انتظر منكم ارسال السيريال Clients Demo 1.03.zip

اعتذر عن تأخرى وغياى لظروف عملى ولكن بفضل الله اساتذتى العظماء الحاضرين يسدون عن الغائبين ويكفون ويوفون ما شاء الله عليهم ربى يحفظهم و يرعاهم اذا انتهت مشاكلك فهنيئا لك ومبارك عليك واذا فى اى شئ تعثرت فيه لا تتردد ابدا ارجع واسأل مرارا وتكرارا وان شاء الله تجد كل الدعم هذا المنتدى ماشاء الله بتربع فى سمائه اساتذة عظماء كالنجوم اللامعة فبأيهم تقتدى ان شاء الله سوف تهتدى معلومة ع الماشى ضع اى ملفات صوتية نسخ ولصق فى المجلد : sound files الموجود بجوار القاعدة وسوف تجدها تلقائيا داخل قائمة التشغيل

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

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

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

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

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

و عليكم السلام ورحمة الله وبركاته إليك المطلوب فئات الانتفاع.xlsx

مش عارف الحل ده ممكن واللا لا انا اساسا مش عارف اذا كنت اساسا فهمت المطلوب 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

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

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

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

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

اخي عند تحميل النموذج يتم حجز السجلات المصدر .. وليس كل عملية بحث تتنفذ مثل الفلتر ومثل المعايير في الاستعلام لذا يجب ان تبحث عن طرق اخرى للبحث وهي كثيرة اليك واحدة منها يمكن تمريرها من خلال السجلات Dim rst As Recordset Dim strSearchName As String Set rst = Me.RecordsetClone strSearchName = tx1 rst.FindFirst "nomarabe = '" & strSearchName & "'" If rst.NoMatch Then MsgBox "Record not found" Else Me.Bookmark = rst.Bookmark End If rst.Close يمكنك ايضا جعل الكود في حدث بعد التحديث لمربع التحرير .. وتحذف ازرار الفلترة BASEL4.rar

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

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

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

الاخ الفاضل :مصطفى حماد سيد حماد لكي تنفذ طلبك عليك بالتالي اولا الطلبة الناجحين من الصف الثالث تنفذ عليهم استعلام تحديث بيانات و تنقلهم للصف الرابع - أي تجعل الرقم الدال على الصف=4- على سبيل المثال - ( يعني تم تخرجهم لان المرحلة 3 صفوف فقط) ثانيا الطلبة الناجحين من الصف الثاني تنفذ عليهم استعلام تحديث و تجعل الرقم الدال على الصف = 3 ثالثا و أخيرا الطلبة الناجحين من الصف الاول تنفذ عليهم استعلام تحديث لرقم الصف و تجعله = 2 رابعا لا بد من تنفيذ الاستعلامات بالترتيب المشار اليه سابق. خامسا الطلبة الراسبين يبقي في نفس الدرجة و لكن ممكن تغير الحقل الدالة على حالته و تجعله = باقي للاعادة اما الجديد يكون حالته مستجد

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

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