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

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

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

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

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

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

دوال 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# وغيرها حسب وضع الكود) بحيث تعمل برامجك على أي بيئة دون مشاكل مستقبلية

تفضل ملف محدث به كل ما طلبت أما بخصوص تعلم الأكواد فالموضوع بسيط و لكن يلزمه شغف التعلم مع المحاولة و الخطأ أجازات 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) أو هذه المعادلة :- =DATE(YEAR(O28) + T28 + INT((MONTH(O28) + S28 - 1) / 12), IF(MOD(MONTH(O28) + S28, 12) = 0, 12, MOD(MONTH(O28) + S28, 12)), DAY(O28) + R28) جرب النتيجة وأخبرنا بها ، في ملفك المرفق التالي :- جمع_.zip

ستبدي لك الأيام ما كنت جاهلا ... ويأتيك بالاخبار من لم تزود متى ؟ .. عندما تتعمق في الاعمال المتنوعة في لحظة تتفاجأ ان البيانات محجوزة ولا يمكنك التعامل معها الا بعد ازالة العلاقة من الجدول متى نحتاج فعلا لاستخدام العلاقات ؟ الجواب : عندما نريد تقييد المستخدم في الادخالات خير دليل بجعل الجداول حرة هي قاعدة بيانات sql server .. الربط يتم في الاستعلامات

انت بالخيار اما ان تجعل التقرير الفرعي في مقطع التفاصيل .. وتجعل ارتفاعة ضيق جدا الى الحد الأدنى بحيث يلامس الحد السفلي الحقول المثال: j4 واما تبقيه على حاله وتعمل معه عكس ذلك فتقوم بتوسيع ارتفاع التقرير الفرعي .. حسب ما ترغب من عرضه يمكن ان تجعل ارتفاعه يأخذ ثلثي الصفحة base_j4.rar وهذه حسب تصميمك base_j5.rar

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

شكرا جزيلا أخي الفاضل وبارك الله فيك وزادك الله من علمه

السلام عليكم واسعد الله اوقاتكم بكل خير المشكلة : بعد الانتهاء من عمل قاعدة لعميل يطلب نسخة للتجربة, ارسل له نسخه تجريبية فيقوم بتسجيل البيانات مثلا قام بإدخال 20 سجلا بعد ذلك يطلب النسخه الكامله ويضطر إلى اعادة ادخال البيانات من جديد الفكرة : خطرت لي فكرة اولا استبعاد فكرتي القديمة وهي الاعتماد على تاريخ معين ثم بعد ذلك يتوقف البرنامج وكذلك يتم تفعيل النسخه دون الحاجه إلى ارسال نسخه جديده واعتماد فكرة ان العميل يقوم بادخال عدد من السجلات ثم بعد ذلك يتوقف الادخال (تقييد السجلات بعدد معين) بعد الوصول لعدد السجلات المتاحه يظهر (INBUTBOX) تفيد بأن النسخه للتجربة للاستمرار يرجى ادخال رمز التفعيل عندما يتم ادخال الرمز الصحيح يستمر البرنامج بالعمل .. مع ملاحظة ما يلي : 1- التفعيل يتم عن طريق ريجستري الجهاز 2- رمز التفعيل لا يتم حفظه في جدول وإنما داخل الكود لتأمينة التطبيق : 1- اضافة هذا المديول في قاعدتك ' التحقق من التفعيل Public Function IsActivated() As Boolean On Error Resume Next IsActivated = GetSetting("MyApp", "Activation", "Activated", "False") = "True" End Function ' تفعيل البرنامج Public Sub ActivateSoftware(pw As String) If pw = "1020" Then SaveSetting "MyApp", "Activation", "Activated", "True" MsgBox "تم تفعيل النسخة بنجاح يمكنك الاستمرار في ادخال السجلات!", vbInformation Else MsgBox "كلمة مرور خاطئة!", vbCritical End If End Sub 2- في نموذج ادخال البيانات عند حدث قبل الادراج اضف : If IsActivated() Then Exit Sub Dim recordCount As Long recordCount = DCount("*", "t1") If recordCount >= 3 Then Dim pw As String pw = InputBox("هذه نسخة للتجربة. يرجى التواصل لطلب رمز التفعيل:", "تفعيل النسخة") Call ActivateSoftware(pw) If Not IsActivated() Then Cancel = True End If End If مرفق لكم التجربه ونستقبل افكاركم الجميله لتحسين هذه الفكرة تقييد النسخه بعدد سجلات محدده.accdb

أخي الفاضل شكرا جزيلا علي الأداة الجميلة كيف أضيف الأدارة لمشروعي ؟ آسف كيف أضيف الأداة لمشوعي ؟

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

تحية طيبة أستاذنا @ابوخليل معذرة على التأخر في الرد بعد تجربة الكود شغال و يؤدي المطلوب - طريقة جيدة- ربما أنا فقط تعودت كثيرا على استعمال الفلترة بواسطة هذا الكود الجميل لأستاذنا @Foksh في هذا الموضوع أفهم من كلامك أستاذنا أن الفلترة غير ممكنة (إظهار سجل المعني بالبحث لوحده) جزاك الله كل الخير أستاذنا @ابوخليل وجعلها في ميزان حساناتك سيتم استعمال كود البحث هذا في النماذج المشابهة لهذا المبدأ كما اشكر كثيرا كذلك أستاذنا @Foksh و ربي يبارك في هذا المنتدى الجميل

السلام عليكم اريد عند ادخال هذا الكود في النموذج الفرعي تظهر لا توجد بيانات اليكم الكود الشه.rar

تفضل Data129.rar

اذا فكلامي صحيح .. وكما توقعته منك انت تعمل حسب علمك ومعرفتك البرمجية .. وهذا خطأ المفروض تعمل حسب فكرك وخيالك الم تلاحظ اني احيانا اطرح اسئلة واطلب المساعدة .. ربما بعض الاستفسارات عادية .. وحلها معروف بالضرورة .. ومع ذلك اسعى الى مشاركة العقول والافكار .. ربما احصل على حلول وافكار لم تخطر على البال . المهم : الآن .. الحل او الفكرة التي عندي لتحقيق مطلبك بعد مراجعة المشروع جيدا : 1- تقرير واحد فقط .. يحقق مطالبك الاربعة 2- بدون اي استعلامات جديدة هل هذا ممكن ؟ نعم .. لأن الاستعلامات موجودة فعلا في المشروع . انتظرني ،،،

كملت وبقى سكه داله عامة وكود مصغر Private Sub ActiveXCtl63_Click() '===( مصدر التقسيم من النموذج الحالي) '===================(حقل الترقيم , عدد التقسيم , اسم الجدول او الاستعلام , اسم النموذج كماهو لفتح التقرير وعبار عن ادوات التحكم , سحب الفلترة من التنموذج الحالي) Call OpenPagedReportWithFilter("D_1", "frm_1", "العملاء", 100, "A7") End Sub Private Sub ActiveXCtl64_Click() '===( مصدر التقسيم من الاستعلام) '===================(حقل الترقيم , عدد التقسيم , اسم الجدول او الاستعلام , اسم النموذج كماهو لفتح التقرير وعبار عن ادوات التحكم) Call OpenPagedReport("frm_1", Me.db.Caption & "_SQL_Date_1", 100, "A7") End Sub Private Sub ActiveXCtl65_Click() '===( مصدر التقسيم من الاستعلام) '===================(حقل الترقيم , عدد التقسيم , اسم الجدول او الاستعلام , اسم النموذج كماهو لفتح التقرير وعبار عن ادوات التحكم) Call OpenPagedReport("frm_1", Me.db.Caption & "_SQL_Date_2", 100, "A7") End Sub

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

مشكلتك من الذي تحذر منه كود الفترة شغال 100% مشكلتك في الكود عند تحميل النموذج BASEL2.rar

اشكركم جميعا على تنويري بالرد على سؤالي شكرا لكم مافائد هذه المكتبات ؟

وعليكم السلام ورحمة الله وبركاته .. هذه الرسالة تعني ان هناك دالة أو وظيفة أو ماكرو يحمل نفس الإسم : Kh_Date_Gender_Province قد يكون على سبيل المثال اسم الدالة بأحد هذه الخيارات :- Sub Kh_Date_Gender_Province() أو Public Function Kh_Date_Gender_Province تحقق من أن اسم الدالة غير مكرر في نفس الأكواد

اكملت يعمل بملايين السجلات للعرض التقارير للمعاينة قبل الطباعة مع التقسيم =========================================( @Foksh 🌹☕ 64 bit مع اقل ذاكرة 4 GB والمفترض يكون على القليل 8 GB احسن من 32 يسخن ويحترق اقصد يعطب لا يستوعب الامكانيات 😂 المهم عرفة وين يشتغل ==================================( استاذ @ابو جودي❤️🌹☕ والمهم ملاحظاتك قبل الرفع واستكمال الموضوع الثاني ====================( ممكن اعدل على الكود

وعليكم السلام ورحمة الله وبركاته ,, حل مشكلتك إن شاء الله بسيط . في المديول اللي في مشروعك الرئيسي ، انقل الدالة التالية :- Public Function RowNum(frm As Form) As Variant On Error GoTo Err_RowNum With frm.RecordsetClone .Bookmark = frm.Bookmark RowNum = .AbsolutePosition + 1 End With Exit_RowNum: Exit Function Err_RowNum: If Err.Number <> 3021& Then Debug.Print "RowNum() error " & Err.Number & " - " & Err.Description End If RowNum = Null Resume Exit_RowNum End Function الآن في النموذج استدعي الدالة التالية في مربع النص الذي تريد الترقيم فيه بدلاً من القديمة :- =RowNum([Form]) وأخبرنا بالنتيجة

شكراً لك على أفادتي بالنتيجة ، وإن شاء الله قريباً إصدار جديد بمميزات خدمية شاملة . أما فيما يخص :- هناك كثير من الأسباب التي تجعل من مستخدمي أوفيس يستخدمون الإصدارات 32-بت ، أذكر لك منها - وليس عموماً - ما يلي :- التوافق مع الإضافات Add-Ins والمكتبات الخارجية . والسبب أن الكثير من هذه الإضافات والمكتبات تعمل بشكل فعال وثابت على الإصدار 32-بت مثل :- ( ActiveX و DLLs و COM ) . في البرامج والمشاريع الكبيرة آكسيس 32-بت يعتبر أكثر استقراراً وثباتاً .. والنقطة المهمة بنظري أنه إذا أنشأت برنامجك بـنسخة 32-بت ، فثق تماماً بأنه سيعمل على آكسيس 32-بت و 64-بت = ( النواتين ) دون حاجتك لتغيير أو إعادة كتابة الأكواد بسبب عدم توافق PtrSafe أو تغيير بعض أنواع البيانات ( مثل Long إلى LongPtr ) ... والعديد غيرها . رأيي الشخصي ، هذه النقطة ليست عميقة بما يكفي ، لأن هدف المبرمج ليس استعراض حداثة النسخة أو نواة النظام أمام المستخدم ، بل تقديم حل مستقر وثابت خالي من الأخطاء والمشاكل ، قابل للصيانة ، وسهل التوزيع على شريحة واسعة من المستخدمين . من وجهة نظر عملية ، إذا كانت النتيجة النهائية واحدة - سواء بُنيت على إصدار قديم أو حديث - فإن الوسيلة المستخدمة تصبح مجرد تفصيل ، وليست مقياساً للذكاء البرمجي . لذلك أختلف معك هنا ، لأن الذكاء الحقيقي يظهر في اختيار الأنسب للواقع ، وليس الأحدث بالضرورة 😁 . 🤗 هذه وجهة نظري وليست ملزمة - وهي قابلة للخطأ أو الصواب - .

أخي محمد المنتدى مليء بالكنوز و ملفات يمكن التعديل عليها بسهولة. مرفق ملف للاستاذ الكبير/ كيماس مع الاستعانة ببعض الأكواد للعلامة خبور. فقط ابحث عن أعمال هؤلاء الأساتذة و غيرهم الكثير مما لا تسعنى الذاكرة لذكرهم سترى و كأنك دخلت مغارة علي بابا. الملف المرفق به فورم مطاطي أي أنك فقط تكتب رؤوس الأعمدة بالعدد الذي تريده و تكتب البيانات و ستجد الفورم تلقائيا مطابق لما كتبته. أتمنى أن نسترجع هذه الملفات و نضيف عليها بعض اللمسات الحديثة وفقا لتطور برنامج الاكسيل و استحداث معادلات جديدة الديناميكى التام لاستعراض السجل وحفظ التغييرات مع الفريمkemas.xlsm

سأحاول تثبيت نسخة أوفيس 2003 وتجربة حفظ نسخة خاصة منه مع التعديل على الأكواد لتتوافق معه 😅 ، وربنا يستر تحديث جديد إن شاء الله قريباً

وعليكم السلام ورحمة الله وبركاته .. معلمنا الجليل والفاضل .. أنا متفاجئ من هذه العقبات التي تظهر عند محاولتك تجربة الملفات التي أقوم برفعها بصيغة ACCDE ، رغم أني خشيت من رفع الصورة التالية لنفس الملف الذي تم رفعه في المشاركة - وملاحظتي انه يعمل دون مشاكل 😢 . سأحاول في التحديث التالي التحقق بشكل أكثر من طريقة حفظ الملف الى accde .. وأعتذر عن هذه المشكلة التي صادفتها 😇

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

أعتقد ان البرنامج غير مرفوع في المنتدى سابقاً من طرف الأستاذ @Barna .. يبدو انه خاص به 😇 . حتى أن الصورة التي ارفقها الأستاذ ناقل تحمل تاريخ اليوم 25/07/2025 😁

وعليكم السلام ورحمة الله وبركاته .. الموضوع ليس صعباً كما تتصور !! هو فقط يحتاج منك ممارسة ومتابعة ومطالعة مواضيع تعليمية وفيديوهات تشرح المبادئ نفسها من الصفر . جميعنا هنا تعلمنا من أخطائنا ومن تجاربنا ومن معلمينا وأساتذتنا الأفاضل بلا شك ، وهنا يأتي دورك أولاً بتعلم الأساسيات التي عندما تتقنها ستجد أنك قطعت شوطاً كبيراً في فهم آلية كتابة الأكواد .

وعليكم السلام ورحمة الله وبركاته .. أخي الفاضل ، الملف المرفق فتح عندي دون ظهور أي مشاكل في اللغة العربية والمسميات كما أرفقت صورتك سابقاً . لذا من الواضح ان مشكلتك في إعدادات الترميز في اللغة العربية .. مشكلتك حلها تقريباً كتطبيق عملي على إصدار ويندوز 10 كما في الصورة التالية :- قد تختلف قليلاً في ويندوز 11 ، ولكن المبدأ واحد ؛ وهو ذهابك الى لوحة التحكم - Control Panel ثم كما في الصورة التالية :- أو ثم اكمل باقي الخطوات كالتالي :- وبعدها سيطلب منك إعادة تشغيل الكمبيوتر لتطبيق التعديلات .

الحل ممكن من خلال الأكواد: و لكن لا تنسى تفعيل اذهب إلى File > Options > Trust Center > Trust Center Settings ثم اذهب إلى Macro Settings فعل الخيار: "Trust access to the VBA project object model" أولا تضع الكود التالي في الملف الذي تريد التصدير منه ' officena.net Sub ExportAllComponentsDynamically() ' --- هذا الكود يقوم بتصدير جميع المكونات ديناميكيًا --- Dim vbComp As Object ' VBComponent Dim exportPath As String Dim componentName As String Dim fileExtension As String ' 1. حدد مسار التصدير exportPath = "C:\ExcelComponents\" ' 2. تأكد من وجود المجلد If Dir(exportPath, vbDirectory) = "" Then MkDir exportPath End If ' 3. ابدأ الحلقة للمرور على كل مكون في المشروع For Each vbComp In ThisWorkbook.VBProject.VBComponents ' تجاهل المكونات الخاصة بالأوراق (Worksheets) و ThisWorkbook If vbComp.Type = 100 Then ' 100 = vbext_ct_Document GoTo NextComponent End If ' 4. حدد امتداد الملف بناءً على نوع المكون Select Case vbComp.Type Case 1 ' vbext_ct_StdModule fileExtension = ".bas" Case 2 ' vbext_ct_ClassModule fileExtension = ".cls" Case 3 ' vbext_ct_MSForm fileExtension = ".frm" Case Else ' تجاهل الأنواع الأخرى GoTo NextComponent End Select ' 5. احصل على اسم المكون componentName = vbComp.Name ' 6. قم بتصدير المكون بالاسم والامتداد الصحيحين Debug.Print "Exporting: " & componentName & fileExtension vbComp.Export exportPath & componentName & fileExtension NextComponent: Next vbComp MsgBox "تم تصدير جميع المكونات بنجاح إلى: " & exportPath End Sub ثانيا تضع الكود التالي في الملف الذي تريد استيراد العناصر إليه ' officena.net Sub ImportAllComponentsDynamically() ' --- هذا الكود يقوم باستيراد جميع المكونات من مجلد محدد --- Dim importPath As String Dim fileName As String ' 1. حدد مسار الاستيراد importPath = "C:\ExcelComponents\" If Dir(importPath, vbDirectory) = "" Then MsgBox "المجلد المحدد غير موجود!", vbCritical Exit Sub End If ' 2. ابدأ بالبحث عن الملفات fileName = Dir(importPath & "*.*") On Error Resume Next ' لتجاهل الأخطاء (مثل محاولة استيراد مكون موجود) ' 3. ابدأ الحلقة للمرور على كل ملف في المجلد Do While fileName <> "" ' 4. تحقق من امتداد الملف قبل الاستيراد If LCase(Right(fileName, 4)) = ".frm" Or _ LCase(Right(fileName, 4)) = ".bas" Or _ LCase(Right(fileName, 4)) = ".cls" Then Debug.Print "Importing: " & fileName Application.VBE.ActiveVBProject.VBComponents.Import importPath & fileName End If ' انتقل إلى الملف التالي fileName = Dir Loop On Error GoTo 0 MsgBox "اكتملت عملية الاستيراد!" End Sub جرب و أبلغنا بالنتيجة اويمكنك استخدام الكود التالي لاستيراد أي عناصر تريدها مباشرة 'Officena.net Sub ImportComponents() ' --- الإصدار الثالث المصحح: استخدام Or بدلاً من In --- Dim sourceWB As Workbook Dim targetWB As Workbook Dim sourceFilePath As Variant Dim tempFolderPath As String Dim vbComp As Object ' VBComponent Dim componentName As String Dim fileExtension As String Dim fileName As String ' --- 1. الإعدادات الأولية --- sourceFilePath = Application.GetOpenFilename( _ FileFilter:="Excel Macro-Enabled Files (*.xlsm), *.xlsm,All Excel Files (*.xls*), *.xls*", _ Title:="الرجاء اختيار ملف Excel المصدر الذي تريد استيراد المكونات منه", _ MultiSelect:=False) If sourceFilePath = False Then MsgBox "تم إلغاء العملية.", vbInformation Exit Sub End If tempFolderPath = Environ("TEMP") & "\VBA_Import_" & Format(Now, "yyyymmdd_hhmmss") & "\" If Dir(tempFolderPath, vbDirectory) = "" Then MkDir tempFolderPath Set targetWB = ThisWorkbook Application.ScreenUpdating = False ' --- 2. فتح المصدر وتصدير المكونات --- On Error GoTo ErrorHandler Set sourceWB = Workbooks.Open(sourceFilePath, ReadOnly:=True, UpdateLinks:=0) sourceWB.Windows(1).Visible = False For Each vbComp In sourceWB.VBProject.VBComponents If vbComp.Type = 100 Then GoTo NextComponent Select Case vbComp.Type Case 1: fileExtension = ".bas" Case 2: fileExtension = ".cls" Case 3: fileExtension = ".frm" Case Else: GoTo NextComponent End Select componentName = vbComp.Name vbComp.Export tempFolderPath & componentName & fileExtension NextComponent: Next vbComp sourceWB.Close SaveChanges:=False Set sourceWB = Nothing ' --- 3. استيراد المكونات إلى الملف الهدف --- fileName = Dir(tempFolderPath & "*.*") Do While fileName <> "" ' === السطر الذي تم تصحيحه === If LCase(Right(fileName, 4)) = ".frm" Or _ LCase(Right(fileName, 4)) = ".bas" Or _ LCase(Right(fileName, 4)) = ".cls" Then On Error Resume Next targetWB.VBProject.VBComponents.Remove targetWB.VBProject.VBComponents(Left(fileName, InStr(fileName, ".") - 1)) On Error GoTo ErrorHandler targetWB.VBProject.VBComponents.Import tempFolderPath & fileName Debug.Print "تم استيراد: " & fileName End If ' ============================ fileName = Dir Loop ' --- 4. التنظيف --- On Error Resume Next Kill tempFolderPath & "*.*" RmDir tempFolderPath On Error GoTo 0 Application.ScreenUpdating = True MsgBox "اكتملت عملية استيراد المكونات بنجاح من الملف: " & vbCrLf & Mid(sourceFilePath, InStrRev(sourceFilePath, "\") + 1), vbInformation Exit Sub ErrorHandler: MsgBox "حدث خطأ:" & vbCrLf & Err.Description, vbCritical, "خطأ" If Not sourceWB Is Nothing Then sourceWB.Close SaveChanges:=False If Dir(tempFolderPath, vbDirectory) <> "" Then On Error Resume Next Kill tempFolderPath & "*.*" RmDir tempFolderPath On Error GoTo 0 End If Application.ScreenUpdating = True End Sub Test.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

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

الأخوة الكرام أسعد الله مساءكم ووفقكم لك خير تحديث جديد يتضمن بعض التعديلات علي نموذج الـ html وهي 1- تم إضافة ميزة البحث بقيم متعدده يفصل بينهم | أو ; أو , وهذا في البحث العام او الحث الخاص بكل نموذج (2) 3- ميزة نسخ كامل محتوي العمود مع أمكانية أختيار الفاصل بينهم او كتابة فاصل جديد (4) وأيضاً اختيار ضم عنوان العمود أم لا (5) 6- تم معالجة بعض القيم لعرض أفضل 7- تم تحسين طريقة نسخ محتوي الخلية للتناسب مع الخلية التي تحمل رابط بداخلها صوره لبعض النتائج بالتوفيق Ahmos_AutoHtmlTable_V1.1_Files.zip

أخي @algammal بما أننا اعتمدنا على العمل الديناميكي أثناء التعامل مع الملف أود أن أشاركك طريقة أخرى أكثر ديناميكية لإنشاء الأزرار الخاصة بالتنقل بين الأوراق دون الحاجة إلى نسخ الارتباطات من ورقة معاشات يتم إنشاء زر لكل ورقة عمل في المصنف بشكل تلقائي - استثناء الورقة التي يشير إليها الزر أي لا يضاف زر داخل نفس الورقة - تلوين الزر بنفس لون تبويب الورقة التي يشير إليها الزر لسهولة التعرف والتمييز البصري ربط الزر بكود التنقل GotoSheet الموضح أدناه مما يتيح الانتقال بين أوراق العمل المقصودة دون الإعتماد على أي إرتباط تشعبي Sub GotoSheet() SetApp False Dim wsName As String wsName = Replace(Application.Caller, "btn_", "") On Error Resume Next ThisWorkbook.Sheets(wsName).Activate On Error GoTo 0 SetApp True End Sub توحيد البحث في شيت واحد v10.xlsb

ربما لديك بيانات في أخر عمود

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

السلام عليكم تفضل أخى هذا الكود يقوم بعمل اللازم Sub ragab() Dim LR As Integer, R As Integer Dim Rng As Range, cl As Range '============================================== Set ws = Sheets("ورقة2") Set WF = Application.WorksheetFunction '============================================== LR = ws.Cells(Rows.Count, 2).End(xlUp).Row Set Rng = ws.Range("B2:B" & LR) Application.ScreenUpdating = False '============================================== Range("B2:M2").Copy If WF.CountIf(Rng, [B2]) > 0 Then ansr = MsgBox("هذا المشروع موجود بالفعل" & Chr(10) & " " & "اذا كنت تريد إستبدالة اضغط نعم" _ & Chr(10) & " " & "وان لم ترد استبداله اضغط لا", vbYesNo, "مشروع مكرر") If ansr = vbYes Then R = WF.Match([B2], Rng, 0) + 1 ws.Range("B" & R).PasteSpecial xlPasteValues GoTo 1 Else GoTo 2 End If End If 2: ws.Range("b" & LR + 1).PasteSpecial xlPasteValues LR = ws.Cells(Rows.Count, 2).End(xlUp).Row For Each cl In ws.Range("A2:A" & LR) cl = cl.Row - 1 Next 1: Application.CutCopyMode = False Application.ScreenUpdating = True End Sub

السلام عليكم في المرفق الكود التالي: Sub ترحيل() Dim L As Integer, R As Integer, C As Integer, CC As Integer, RR As Integer L = Range("A" & Rows.Count).End(xlUp).Row With ورقة2 For R = 2 To L For C = 1 To 17 If Cells(R, 3).Value = .Cells(1, C).Value Then CC = .Cells(1, C).Column For RR = 3 To 33 If Cells(R, 2).Value = .Cells(RR, CC).Value Then .Cells(RR, CC + 1) = Cells(R, 4) .Cells(RR, CC + 2) = Cells(R, 5) End If Next RR End If Next C Next R End With MsgBox "تم الترحيل بنجاح", vbMsgBoxRtlReading + vbMsgBoxRight, "الحمدلله" End Sub Book1.rar

السلام عليكم تفضل المرفق ان شاء الله يكون طلبك ________________.rar