husain alhammadi

السلام عليكم و رحمة الله و بركاتة تحية طيبة لكل أعضاء المنتدى الكرام، يسرني أن أعلن عن إنجاز ملف "الجزر والمد" (Tides and Islands). لقد تم تجميع وإعداد هذا الملف بفضل جهودكم ودعمكم المستمر، وبمساعدة أدوات بحث وتحليل متقدمة مثل Gemini، بهدف توفير مرجع شامل ومفيد حول هذا الموضوع الهام، مع تركيز خاص على الموقع/المواقع الجغرافية التي يغطيها التحليل. 🌟 لماذا نحتاج إلى ملاحظاتكم؟ (للتدقيق والتطوير) هذا العمل هو ملك للجميع، ولضمان دقته وفائدته القصوى، فإنني أتوجه إليكم بطلب هام: 1. تسجيل الملاحظات وتصحيح الأخطاء: أرجو من كل من يجد أي خطأ (علمي، لغوي، أو فني)، خاصة فيما يتعلق ببيانات الموقع الجغرافي المشمول في الملف، أو يرى أن هناك معلومة تحتاج إلى تعديل أو توضيح، أن يسجل ملاحظته مشكورًا. 2. التطوير والإضافة: أرحب بأي اقتراحات تهدف إلى تطوير محتوى الملف وإثرائه بمعلومات إضافية، وخصوصًا ما يخص تغطية الموقع، سواء بإضافة إحداثيات، خرائط تفصيلية، أو أي معلومات ذات صلة به. عملنا الجماعي هو سر قوتنا. ساهموا معنا في جعل هذا الملف المرجع الأفضل والأكثر دقة في المنتدى. شكرًا جزيلاً لجهودكم وتعاونكم المثمر. مع خالص التحية والتقدير، ‏‏‏‏الجزر و المد.xlsm

السلام عليكم و رحمة الله و بركاتة هل يوجد خطاء في الكود Private Sub CommandButton1_Click() On Error GoTo ErrorHandler Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Dim wsSource As Worksheet Dim wsTarget As Worksheet Dim conditionValue As Long Dim startColumnIndex As Long Dim sourceColumnIndex As Long Dim NumberOfRows As Long Dim sourceRange As Range Dim targetRange As Range NumberOfRows = 30 On Error GoTo SheetError Set wsSource = ThisWorkbook.Sheets("Sheet4") Set wsTarget = ThisWorkbook.Sheets("Sheet3") On Error GoTo ErrorHandler If IsNumeric(wsTarget.Range("B2").Value) And Not IsEmpty(wsTarget.Range("B2").Value) Then conditionValue = CLng(wsTarget.Range("B2").Value) Else MsgBox "يجب أن تكون القيمة في الخلية B2 رقمًا يمثل الشهر (1-12).", vbCritical GoTo CleanUp End If If conditionValue >= 1 And conditionValue <= 12 Then startColumnIndex = 1 + (conditionValue - 1) * 6 Else MsgBox "القيمة خارج النطاق المسموح به (1-12).", vbExclamation GoTo CleanUp End If sourceColumnIndex = startColumnIndex + 2 Set sourceRange = wsSource.Range( _ wsSource.Cells(2, sourceColumnIndex), _ wsSource.Cells(1 + NumberOfRows, sourceColumnIndex) _ ) Set targetRange = wsTarget.Range( _ wsTarget.Cells(5, 3), _ wsTarget.Cells(4 + NumberOfRows, 3) _ ) targetRange.Value = sourceRange.Value Application.CutCopyMode = False ThisWorkbook.Save MsgBox "? تم ترحيل البيانات بنجاح وحفظ المصنف.", vbInformation CleanUp: Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True Exit Sub ErrorHandler: MsgBox "? حدث خطأ غير متوقع: " & Err.Description, vbCritical Resume CleanUp SheetError: MsgBox "?? خطأ في أسماء أوراق العمل: تأكد من أن أسماء أوراق العمل هي 'Sheet4' و 'Sheet3' بشكل صحيح.", vbCritical Resume CleanUp End Sub ‏‏‏‏الجزر و المد - 999.xlsm

السلام عليكم و رحمة الله و بركاتة تحية طيبة لكم جميعًا، أعضاء منتدانا الكرام، نأمل أن تكونوا بأفضل حال. كما تعلمون، يُعتبر ملف المد والجزر (Tide & Currents) أحد المصادر الهامة والمفيدة التي نعتمد عليها في المنتدى، خاصة للأعضاء المهتمين بالصيد، الملاحة، أو أي نشاط يتطلب معرفة دقيقة بأحوال البحر وحركة المياه. ونظرًا للطبيعة المتغيرة لهذه البيانات وحرصًا منا على توفير أدق وأحدث المعلومات لجميع الأعضاء، نود أن نطلب من كل من لديه نسخة من هذا الملف أو لديه القدرة على الوصول إلى مصادر بيانات أحدث وأكثر شمولاً، مساعدتنا في مراجعته وتحديثه. لماذا نحتاج إلى التحديث؟ الدقة: ضمان أن تكون التوقعات والأرقام المسجلة في الملف حديثة ومطابقة للتغيرات السنوية. الشمولية: إضافة محطات أو مناطق جديدة قد تهم الأعضاء. الصلاحية: التأكد من أن الملف يغطي الفترة الزمنية القادمة بشكل كامل. كيف يمكنكم المساعدة؟ المراجعة: إذا كانت لديكم خبرة في هذا المجال، نرجو مراجعة البيانات الحالية للتأكد من دقتها. التزويد بالملفات الجديدة: إذا كنتم تمتلكون نسخة محدّثة للعام القادم (أو الفترة الحالية)، نرجو مشاركتها. المصادر الموثوقة: مشاركة روابط أو أسماء لجهات أو برامج توفر بيانات دقيقة وموثوقة للمد والجزر. نرجو إرسال أي ملاحظات، تعديلات، أو ملفات محدّثة إلى مشرفي القسم أو الرد مباشرة على هذا الموضوع ليتم تجميعها وتطبيق التعديلات اللازمة. شاكرين لكم تعاونكم المستمر ومساهمتكم القيمة في إثراء منتدانا. مع خالص التقدير، tide_scraper.py.xlsm

🚀 السلام عليكم و رحمة الله و بركاتة أنا سعيد بتقديم هذا البرنامج، ولكي يصبح أداة مثالية لنا جميعًا، نحتاج إلى خبرتكم الجماعية. أدعوكم للمشاركة في تطوير البرنامج من خلال: المقترحات: كيف يمكن تكييف هذه الأداة لتناسب مشاكلنا الثقافية أو اليومية الخاصة؟ التطبيقات: شاركونا أمثلة عن مشكلة شخصية طبقوا عليها "الخمسة لماذا" وماذا كان اكتشافكم الجذري. التحديات: ما هي الصعوبات التي واجهتكم عند محاولة الوصول إلى "لماذا 5"؟ بمشاركتكم، سنجعل من "الخمسة لماذا" منهجية يومية تثري حياتنا. بانتظار مساهماتكم القيمة! مع خالص التقدير، لماذا.xlsx

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

السلام عليكم و رحمة الله و بركاتة الزملاء الكرام وأعضاء المنتدى الموقرين، تحية طيبة وبعد، نتشرف بإبلاغكم، بفضل الله وتوفيقه، اكتمال المرحلة التطويرية النهائية لتطبيقنا المبارك: [القرآن الكريم]. نأمل أن يكون هذا العمل وقفاً رقمياً مستداماً، وأن يكتب أجره لمن ساهم في إنجازه مادياً وتقنياً. دعوة للمراجعة الفنية وضمان الجودة (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