husain alhammadi

"الزملاء/الكرام، باطلاعكم على التفاصيل المرفقة، تجدون أن المبادرة/المشروع/الموضوع [القرآن الكريم] بات تحت تصرفكم المباشر. لكم كامل الصلاحية والحق في تقرير المسار الأنسب والمضي قدمًا في عملية التطوير التي ترونها مثالية. انا اثق في رؤيتكم وقدرتكم على تحديد أفضل الخيارات لتنميته ودفعه نحو الأمام. انا على استعداد لتقديم أي دعم أو معلومات إضافية قد تحتاجونها. مع أطيب التمنيات بالتوفيق والنجاح،"

السلام عليكم و رحمة الله و بركاتة الزملاء الكرام وأعضاء المنتدى الموقرين، تحية طيبة وبعد، نتشرف بإبلاغكم، بفضل الله وتوفيقه، اكتمال المرحلة التطويرية النهائية لتطبيقنا المبارك: [القرآن الكريم]. نأمل أن يكون هذا العمل وقفاً رقمياً مستداماً، وأن يكتب أجره لمن ساهم في إنجازه مادياً وتقنياً. دعوة للمراجعة الفنية وضمان الجودة (Quality Assurance): قبل الإطلاق الرسمي والتعميم، ندعوكم، خاصةً من ذوي الخبرة التقنية والمستخدمين المتمرسين، لتحميل النسخة التجريبية والمشاركة في مراجعتها بدقة وعمق. إن الهدف الجوهري من هذه المرحلة هو: ضمان جودة الأداء: والتأكد من توافق التطبيق مع المعايير التقنية واحتياجات شرائح المستخدمين المتنوعة. تحديد نقاط التحسين: واكتشاف أي مواطن خلل أو قصور فني ووظيفي يتطلب تعديلاً. تحقيق التكاملية: للوصول إلى أفضل تجربة مستخدم ممكنة. نؤكد استعداد فريق العمل لدمج وتطبيق الملاحظات البنّاءة التي تصب في مصلحة الهدف العام للتطبيق، مع الالتزام التام بإعادة نشر النسخة المحسّنة والموثقة لجميع المساهمين والجمهور، تحقيقاً لمبدأ "الصدقة الجارية والمنفعة العامة". ختاماً، ندعو المولى عز وجل أن يتقبل هذا الجهد المشترك وأن يجعله في ميزان حسنات كل من شارك في بناء هذا العمل وفي تحسينه ونشره. مع خالص التقدير والامتنان، حسين الحمادي ابو يوسف القران الكريم.xlsm

السلام عليكم و رحمة الله و بركاتة تحية طيبة أعضاء منتدانا الكرام، بقلوب ملؤها الشكر والامتنان، وبفضل الله وتوفيقه، نعلن لكم عن الانتهاء بنجاح من تطوير برنامجنا المبارك: [محضر الاجتماع]، والذي نأمل أن يكون صدقة جارية لنا جميعاً، ولمن ساهم فيه مادياً أو معنوياً. نداء للمعاينة والملاحظات (لإتمام الصدقة الجارية): لقد تم إنجاز البرنامج وتهيئته للنشر، ولكن قبل إطلاقه بشكل رسمي ليستفيد منه الجميع، نرجو منكم، أيها الخبراء والمستخدمون الكرام، معاينة البرنامج بدقة وإبداء ملاحظاتكم القيمة حوله. هدفنا من هذه الخطوة هو: ضمان جودة البرنامج وتوافقه مع احتياجات مختلف المستخدمين. اكتشاف أي قصور أو نقاط تحتاج إلى تحسين وتعديل. جعله أداة متكاملة وسهلة الاستخدام قدر الإمكان. نحن على استعداد تام لتعديل الملاحظات التي تتناسب مع الهدف العام للبرنامج، شريطة أن يتم بعد ذلك إعادة نشر النسخة المعدلة لجميع الأعضاء والمهتمين، ليتحقق مبدأ "الصدقة الجارية" والاستفادة العامة. أخيراً، ندعو الله أن يتقبل هذا الجهد المشترك في ميزان حسنات كل من شارك في إنجاز البرنامج، وكل من سيشارك في تحسينه ونشره. محضر الاجتماع.xlsm

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

السلام عليكم و رحمة الله و بركاتة اخواني ارفق لكم الكود مع الملف و ارجوا مساعدتي في حلها لانها لا تعمل و شكرا لكم Private Sub CommandButton2_Click() Dim wsSource As Worksheet Set wsSource = ThisWorkbook.Sheets("Sheet4") wsSource.Range("B3, D4, D5, D6, C54, C57:C59, B61, C11:C17, E11:E17, G11:G17, C21:C27, E21:E27, G21:G27, B37:B43, B47:B51, G47:G51, C31:C34, G31:G34").ClearContents End Sub محضر الاجتماع.xlsm

السلام عليكم و رحمة الله و بركاتة اخواني تم حل المشكلة محضر الاجتماع.xlsm

Private Sub CommandButton1_Click() Dim wsSource As Worksheet Dim wsDestination As Worksheet Dim NextRow As Long On Error GoTo ErrorHandler ' 1. تعيين أوراق العمل Set wsSource = ThisWorkbook.Sheets("Sheet1") Set wsDestination = ThisWorkbook.Sheets("Sheet2") ' 2. إيجاد الصف التالي الفارغ NextRow = wsDestination.Cells(wsDestination.Rows.Count, "B").End(xlUp).Row + 1 ' ضمان أن يبدأ النقل من الصف 3 على الأقل If NextRow < 3 Then NextRow = 3 ' 3. نقل القيم wsDestination.Cells(NextRow, "A").Value = wsSource.Range("D4").Value wsDestination.Cells(NextRow, "B").Value = wsSource.Range("B3").Value wsDestination.Cells(NextRow, "C").Value = wsSource.Range("D5").Value wsDestination.Cells(NextRow, "D").Value = wsSource.Range("D6").Value wsDestination.Cells(NextRow, "E").Value = wsSource.Range("G4").Value wsDestination.Cells(NextRow, "F").Value = wsSource.Range("G5").Value wsDestination.Cells(NextRow, "G").Value = wsSource.Range("G6").Value wsDestination.Cells(NextRow, "S").Value = wsSource.Range("C54").Value wsDestination.Cells(NextRow, "T").Value = wsSource.Range("C57").Value wsDestination.Cells(NextRow, "U").Value = wsSource.Range("C58").Value wsDestination.Cells(NextRow, "V").Value = wsSource.Range("C59").Value wsDestination.Cells(NextRow, "W").Value = wsSource.Range("B61").Value ' نقل النطاقات العمودية wsDestination.Range("I" & NextRow & ":I" & NextRow + 6).Value = wsSource.Range("E11:E17").Value wsDestination.Range("J" & NextRow & ":J" & NextRow + 6).Value = wsSource.Range("G11:G17").Value wsDestination.Range("K" & NextRow & ":K" & NextRow + 6).Value = wsSource.Range("C21:C27").Value wsDestination.Range("L" & NextRow & ":L" & NextRow + 6).Value = wsSource.Range("E21:E27").Value wsDestination.Range("M" & NextRow & ":M" & NextRow + 6).Value = wsSource.Range("G21:G27").Value wsDestination.Range("P" & NextRow & ":P" & NextRow + 6).Value = wsSource.Range("B37:B43").Value ' نقل النطاقات المتوسطة wsDestination.Range("Q" & NextRow & ":Q" & NextRow + 4).Value = wsSource.Range("B47:B51").Value wsDestination.Range("R" & NextRow & ":R" & NextRow + 4).Value = wsSource.Range("G47:G51").Value ' نقل النطاقات القصيرة wsDestination.Range("N" & NextRow & ":N" & NextRow + 3).Value = wsSource.Range("C31:C34").Value wsDestination.Range("O" & NextRow & ":O" & NextRow + 3).Value = wsSource.Range("G31:G34").Value ' 4. مسح المعلومات من ورقة المصدر (Sheet1) With wsSource .Range("D4, B3, D5, D6, G4, G5, G6, C54").ClearContents .Range("C57, C58, C59, B61").ClearContents .Range("E11:E17, G11:G17, C21:C27, E21:E27, G21:G27, B37:B43").ClearContents .Range("B47:B51, G47:G51").ClearContents .Range("C31:C34, G31:G34").ClearContents End With ' 5. رسالة النجاح MsgBox "تم نقل البيانات بنجاح إلى الصف " & NextRow & " وتم مسح البيانات المصدر من Sheet1.", vbInformation Exit Sub ErrorHandler: Application.CutCopyMode = False MsgBox "حدث خطأ في تحديد أوراق العمل. الرجاء التأكد من مطابقة اسم الورقة تمامًا لما هو مكتوب في علامة تبويب Excel." & vbCrLf & "الخطأ: " & Err.Description, vbCritical End Sub بالنسبة للترحيل تم حل المشكلة و المتبقي مسح البيانات من sheet1 بعد نقل المعلوات الى sheet2 محضر الاجتماع.xlsm

Private Sub CommandButton1_Click() Application.ScreenUpdating = False Dim wsSource As Worksheet Dim wsTarget As Worksheet Dim NextRow As Long Dim i As Long Dim StartRow As Long Set wsSource = Worksheets("Sheet1") Set wsTarget = Worksheets("Sheet2") StartRow = wsTarget.Cells(Rows.Count, "A").End(xlUp).Row + 1 NextRow = StartRow If NextRow < 3 Then NextRow = 3 For i = 0 To 5 wsTarget.Cells(NextRow, "A").Value = wsSource.Range("D4").Value wsTarget.Cells(NextRow, "B").Value = wsSource.Range("B3").Value wsTarget.Cells(NextRow, "C").Value = wsSource.Range("D5").Value wsTarget.Cells(NextRow, "D").Value = wsSource.Range("D6").Value wsTarget.Cells(NextRow, "E").Value = wsSource.Range("G4").Value wsTarget.Cells(NextRow, "F").Value = wsSource.Range("G5").Value wsTarget.Cells(NextRow, "G").Value = wsSource.Range("G6").Value wsTarget.Cells(NextRow, "H").Value = wsSource.Range("C" & (11 + i)).Value wsTarget.Cells(NextRow, "I").Value = wsSource.Range("E" & (11 + i)).Value If i < 5 Then wsTarget.Cells(NextRow, "J").Value = wsSource.Range("G" & (11 + i)).Value Else wsTarget.Cells(NextRow, "J").Value = wsSource.Range("G17").Value End If NextRow = NextRow + 1 Next i For i = 0 To 6 wsTarget.Cells(NextRow, "A").Value = wsSource.Range("D4").Value wsTarget.Cells(NextRow, "B").Value = wsSource.Range("B3").Value wsTarget.Cells(NextRow, "C").Value = wsSource.Range("D5").Value wsTarget.Cells(NextRow, "D").Value = wsSource.Range("D6").Value wsTarget.Cells(NextRow, "E").Value = wsSource.Range("G4").Value wsTarget.Cells(NextRow, "F").Value = wsSource.Range("G5").Value wsTarget.Cells(NextRow, "G").Value = wsSource.Range("G6").Value wsTarget.Cells(NextRow, "K").Value = wsSource.Range("C" & (21 + i)).Value wsTarget.Cells(NextRow, "L").Value = wsSource.Range("E" & (21 + i)).Value wsTarget.Cells(NextRow, "M").Value = wsSource.Range("G" & (21 + i)).Value NextRow = NextRow + 1 Next i For i = 0 To 3 wsTarget.Cells(NextRow, "A").Value = wsSource.Range("D4").Value wsTarget.Cells(NextRow, "B").Value = wsSource.Range("B3").Value wsTarget.Cells(NextRow, "C").Value = wsSource.Range("D5").Value wsTarget.Cells(NextRow, "D").Value = wsSource.Range("D6").Value wsTarget.Cells(NextRow, "E").Value = wsSource.Range("G4").Value wsTarget.Cells(NextRow, "F").Value = wsSource.Range("G5").Value wsTarget.Cells(NextRow, "G").Value = wsSource.Range("G6").Value wsTarget.Cells(NextRow, "N").Value = wsSource.Range("C" & (31 + i)).Value wsTarget.Cells(NextRow, "O").Value = wsSource.Range("G" & (31 + i)).Value NextRow = NextRow + 1 Next i For i = 0 To 6 wsTarget.Cells(NextRow, "A").Value = wsSource.Range("D4").Value wsTarget.Cells(NextRow, "B").Value = wsSource.Range("B3").Value wsTarget.Cells(NextRow, "C").Value = wsSource.Range("D5").Value wsTarget.Cells(NextRow, "D").Value = wsSource.Range("D6").Value wsTarget.Cells(NextRow, "E").Value = wsSource.Range("G4").Value wsTarget.Cells(NextRow, "F").Value = wsSource.Range("G5").Value wsTarget.Cells(NextRow, "G").Value = wsSource.Range("G6").Value wsTarget.Cells(NextRow, "P").Value = wsSource.Range("B" & (37 + i)).Value NextRow = NextRow + 1 Next i For i = 0 To 4 wsTarget.Cells(NextRow, "A").Value = wsSource.Range("D4").Value wsTarget.Cells(NextRow, "B").Value = wsSource.Range("B3").Value wsTarget.Cells(NextRow, "C").Value = wsSource.Range("D5").Value wsTarget.Cells(NextRow, "D").Value = wsSource.Range("D6").Value wsTarget.Cells(NextRow, "E").Value = wsSource.Range("G4").Value wsTarget.Cells(NextRow, "F").Value = wsSource.Range("G5").Value wsTarget.Cells(NextRow, "G").Value = wsSource.Range("G6").Value wsTarget.Cells(NextRow, "Q").Value = wsSource.Range("B" & (47 + i)).Value wsTarget.Cells(NextRow, "R").Value = wsSource.Range("G" & (47 + i)).Value NextRow = NextRow + 1 Next wsTarget.Cells(NextRow, "A").Value = wsSource.Range("D4").Value wsTarget.Cells(NextRow, "B").Value = wsSource.Range("B3").Value wsTarget.Cells(NextRow, "C").Value = wsSource.Range("D5").Value wsTarget.Cells(NextRow, "D").Value = wsSource.Range("D6").Value wsTarget.Cells(NextRow, "E").Value = wsSource.Range("G4").Value wsTarget.Cells(NextRow, "F").Value = wsSource.Range("G5").Value wsTarget.Cells(NextRow, "G").Value = wsSource.Range("G6").Value wsTarget.Cells(NextRow, "S").Value = wsSource.Range("C54").Value wsTarget.Cells(NextRow, "T").Value = wsSource.Range("C57").Value wsTarget.Cells(NextRow, "U").Value = wsSource.Range("C58").Value wsTarget.Cells(NextRow, "V").Value = wsSource.Range("C59").Value wsTarget.Cells(NextRow, "W").Value = wsSource.Range("B61").Value Application.ScreenUpdating = True MsgBox "تم ترحيل البيانات بنجاح إلى " & (NextRow) & " صفوف.", vbInformation End Sub السلام عليكم و رحمة الله و بركاتة ارفق لكم المرفق بعد التعديل و لا يزال لايتم الترحيل و في الملف يوجد رقم سري 123 و لكم مني جزيل الشكر محضر الاجتماع.xlsm

السلام عليكم و رحمة الله و بركاتة بارك الله فيك Foksh و جزاك الله خير الجزاء و زادك الله علما الكود لا يرحل الى sheet2

السلام عليكم و رحمة الله و بركاتة ارجوا مساعدتي في تعديل الكود التالي Private Sub CommandButton1_Click() ' إيقاف تحديث الشاشة لتسريع العملية Application.ScreenUpdating = False Dim wsSource As Worksheet Dim wsTarget As Worksheet Dim NextRow As Long ' تحديد ورقة العمل المصدر (Sheet1) وورقة العمل الهدف (Sheet2) Set wsSource = Worksheets("Sheet1") Set wsTarget = Worksheets("Sheet2") ' 1. البحث عن الصف الفارغ التالي في العمود A NextRow = wsTarget.Cells(Rows.Count, "A").End(xlUp).Row + 1 ' 2. ضمان أن يبدأ ترحيل البيانات من الصف رقم 3 على الأقل If NextRow < 3 Then NextRow = 3 ' ------------------------------------------------------------- ' نقل البيانات إلى الصف الجديد (NextRow) في Sheet2 ' ------------------------------------------------------------- ' الأعمدة A إلى F wsTarget.Cells(NextRow, "A").Value = wsSource.Range("D4").Value wsTarget.Cells(NextRow, "B").Value = wsSource.Range("D5").Value wsTarget.Cells(NextRow, "C").Value = wsSource.Range("D6").Value wsTarget.Cells(NextRow, "D").Value = wsSource.Range("H4").Value wsTarget.Cells(NextRow, "E").Value = wsSource.Range("H5").Value wsTarget.Cells(NextRow, "F").Value = wsSource.Range("H6").Value ' الأعمدة G, H, I (القيم الأخيرة هي التي تُحفظ) wsTarget.Cells(NextRow, "G").Value = wsSource.Range("E11").Value wsTarget.Cells(NextRow, "H").Value = wsSource.Range("G11").Value wsTarget.Cells(NextRow, "I").Value = wsSource.Range("C12").Value wsTarget.Cells(NextRow, "H").Value = wsSource.Range("E12").Value wsTarget.Cells(NextRow, "I").Value = wsSource.Range("G12").Value wsTarget.Cells(NextRow, "H").Value = wsSource.Range("E13").Value wsTarget.Cells(NextRow, "I").Value = wsSource.Range("G13").Value wsTarget.Cells(NextRow, "G").Value = wsSource.Range("E14").Value wsTarget.Cells(NextRow, "I").Value = wsSource.Range("G14").Value wsTarget.Cells(NextRow, "G").Value = wsSource.Range("E15").Value wsTarget.Cells(NextRow, "I").Value = wsSource.Range("G15").Value wsTarget.Cells(NextRow, "G").Value = wsSource.Range("E16").Value wsTarget.Cells(NextRow, "I").Value = wsSource.Range("G16").Value wsTarget.Cells(NextRow, "G").Value = wsSource.Range("E17").Value wsTarget.Cells(NextRow, "I").Value = wsSource.Range("G17").Value ' الأعمدة J و L (القيم الأخيرة هي التي تُحفظ) wsTarget.Cells(NextRow, "J").Value = wsSource.Range("C21").Value wsTarget.Cells(NextRow, "L").Value = wsSource.Range("G21").Value wsTarget.Cells(NextRow, "J").Value = wsSource.Range("C22").Value wsTarget.Cells(NextRow, "L").Value = wsSource.Range("G22").Value wsTarget.Cells(NextRow, "J").Value = wsSource.Range("C23").Value wsTarget.Cells(NextRow, "L").Value = wsSource.Range("G23").Value wsTarget.Cells(NextRow, "J").Value = wsSource.Range("C24").Value wsTarget.Cells(NextRow, "L").Value = wsSource.Range("G24").Value wsTarget.Cells(NextRow, "J").Value = wsSource.Range("C25").Value wsTarget.Cells(NextRow, "L").Value = wsSource.Range("G25").Value wsTarget.Cells(NextRow, "J").Value = wsSource.Range("C26").Value wsTarget.Cells(NextRow, "L").Value = wsSource.Range("G26").Value wsTarget.Cells(NextRow, "J").Value = wsSource.Range("C27").Value wsTarget.Cells(NextRow, "L").Value = wsSource.Range("G27").Value ' الأعمدة M و N (القيم الأخيرة هي التي تُحفظ) wsTarget.Cells(NextRow, "M").Value = wsSource.Range("C31").Value wsTarget.Cells(NextRow, "N").Value = wsSource.Range("H31").Value wsTarget.Cells(NextRow, "M").Value = wsSource.Range("C32").Value wsTarget.Cells(NextRow, "N").Value = wsSource.Range("H32").Value wsTarget.Cells(NextRow, "M").Value = wsSource.Range("C33").Value wsTarget.Cells(NextRow, "N").Value = wsSource.Range("H33").Value wsTarget.Cells(NextRow, "M").Value = wsSource.Range("C34").Value wsTarget.Cells(NextRow, "N").Value = wsSource.Range("H34").Value ' الأعمدة O, C, P, Q (القيم الأخيرة هي التي تُحفظ) wsTarget.Cells(NextRow, "O").Value = wsSource.Range("B38").Value wsTarget.Cells(NextRow, "C").Value = wsSource.Range("B39").Value wsTarget.Cells(NextRow, "O").Value = wsSource.Range("B40").Value wsTarget.Cells(NextRow, "C").Value = wsSource.Range("B41").Value wsTarget.Cells(NextRow, "O").Value = wsSource.Range("B42").Value wsTarget.Cells(NextRow, "P").Value = wsSource.Range("B47").Value wsTarget.Cells(NextRow, "P").Value = wsSource.Range("B48").Value wsTarget.Cells(NextRow, "O").Value = wsSource.Range("B49").Value wsTarget.Cells(NextRow, "Q").Value = wsSource.Range("H49").Value wsTarget.Cells(NextRow, "Q").Value = wsSource.Range("H50").Value wsTarget.Cells(NextRow, "Q").Value = wsSource.Range("H51").Value ' الأعمدة R, S, T, U wsTarget.Cells(NextRow, "R").Value = wsSource.Range("C57").Value wsTarget.Cells(NextRow, "S").Value = wsSource.Range("C58").Value wsTarget.Cells(NextRow, "T").Value = wsSource.Range("C59").Value wsTarget.Cells(NextRow, "U").Value = wsSource.Range("B59").Value ' إعادة تشغيل تحديث الشاشة Application.ScreenUpdating = True MsgBox "تم ترحيل البيانات بنجاح إلى ورقة العمل 'Sheet2' في الصف رقم " & NextRow & ".", vbInformation End Sub محضر الاجتماع.xlsm

السلام عليكم و رحمة الله و بركاتة مرحباً بالجميع، لقد قمت بإنجاز برنامج يعمل بشكل جيد، وأحتاج الآن إلى إضافة ميزة تحويل النص إلى صوت (Text-to-Speech) كخطوة أخيرة. المطلوب: كود VBA يتم تشغيله على ملفات Excel، يقوم بتحويل النصوص الموجودة في العمود C من كل ورقة عمل (Sheet) إلى صوت، ربما بوجود زر تشغيل في كل ملف أو عن طريق ماكرو مخصص. الهدف: قراءة محتويات العمود C صوتيًا لتسهيل التدقيق والمراجعة. هل يمكن لأحد أن يشارك كود VBA الذي يمكن أن ينجز هذه المهمة؟ أو هل هناك دالة جاهزة في VBA يمكنها القيام بذلك؟ شكرًا جزيلاً لكم على المساعدة والوقت Copy of تجربة 4.xlsm

Private Sub UserForm_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) If KeyCode = vbKeyEscape Then Unload Me KeyCode = 0 End If End Sub عليكم السلام و رحمة الله و بركاتة جرب هذا الكود

هل يمكن اضاف هذ الكود للملف Private Sub CommandButton1_Click() Dim uForm As Object Dim i As Long Dim MyRng As Variant Dim Nameform As String Dim TempName As Variant Dim WaitTime As Double ' قم بإلغاء On Error Resume Next المبدئية MyRng = Sheets("Sheet1").Range("A2:B21").Value Application.Visible = False ' إخفاء التطبيق On Error GoTo ErrorHandler ' معالج أخطاء عام لضمان إعادة الإظهار For i = 1 To UBound(MyRng, 1) TempName = MyRng(i, 1) ' معالجة خطأ القراءة لـ WaitTime On Error Resume Next WaitTime = MyRng(i, 2) If Err.Number <> 0 Then WaitTime = -1 ' تعيين قيمة غير صالحة إذا حدث خطأ Err.Clear On Error GoTo ErrorHandler ' العودة إلى معالج الأخطاء العام ' التحقق من القيمة وتنقيتها If Not IsError(TempName) Then Nameform = Trim(CStr(TempName)) Else Nameform = "" End If ' التحقق من الشروط If Nameform <> "" And IsNumeric(WaitTime) And WaitTime >= 0 Then ' معالجة خطأ عدم وجود النموذج On Error Resume Next Set uForm = UserForms.Add(Nameform) If Err.Number <> 0 Then Application.Speech.Speak "خطأ. النموذج غير موجود: " & Nameform, SpeakAsync:=False Err.Clear On Error GoTo ErrorHandler GoTo NextIteration ' تخطي الدورة الحالية End If On Error GoTo ErrorHandler ' العودة إلى معالج الأخطاء العام Application.Speech.Speak "عرض النموذج: " & Nameform, SpeakAsync:=False If Not uForm Is Nothing Then DoEvents uForm.Show 0 ' تأكد من أن الوقت لا يتجاوز 60 ثانية بشكل مفرط (اختياري) If WaitTime > 60 Then WaitTime = 60 Application.Wait Now + TimeValue("00:00:" & Format(WaitTime, "00")) DoEvents Unload uForm End If Set uForm = Nothing End If NextIteration: Next i ' الخروج الطبيعي Application.Visible = True Exit Sub ' معالج الأخطاء الرئيسي ErrorHandler: Application.Visible = True ' إعادة إظهار التطبيق في حال حدوث خطأ MsgBox "حدث خطأ غير متوقع برقم: " & Err.Number & vbCrLf & "الوصف: " & Err.Description, vbCritical, "خطأ في تشغيل الكود" End Sub Copy of تجربة 4.xlsm

أرغب في التعبير عن شكري العميق لـ الأستاذ محمد هشام. أنت لست مجرد خبير، بل عمود من أعمدة هذا المنتدى. إن حرصك على تقديم الدعم والمشاركة بمعرفتك بتواضع واحترافية هو أمر يُحتذى به. شكرًا لك على كل معلومة قدمتها، وكل سؤال أجبت عنه، وكل توجيه كان في محله Copy of تجربة 4.xlsm

بارك الله فيك الاخ hegazee ترِيد النَّجاح ثقْ بالله ثمَّ بنفْسك وتَجاهَل منْ يقُـول هَذا صعْب وَهذا مستَحيل ، الثِّقة بِالله هِي عقليَّة العُظَماء. اتفق معاك بان البوربوينت يصلح أكثر من الاكسيل لهذا البرنامج و لكن ليس مستحيلة و يوجد الاف برنامج البوربوينت و لكن لا يوجد اكسل فنحن نريد التميز و يد بيد سنصل ان شاء الله و لو كل شخص بفكرة سيكتمل بعون الله