رجاء اضافة زر يحول نتيجة البحث فيي شيتين اكسل الى صفحة وورد

[Alaa Ammar New]

السلام عليكم ورحمة الله وبركاته

إخواني الكرام والأعزاء - مرفق لكم ملف اكسل ساعدني فيه أساتذتي الكرام المحترمين @محمد هشام. و @حسونة حسين

طمعًا في كرمكم الشديد وخبراتكم الواسعة وعلمكم المستفيض أرجو من سيادتكم رجاء إضافة زرار في "SHEET1" و"الأنشطة" و"تكافؤ الفرص" يحول نتيجة البحث بخرف كما في SHEET1 او بين تاريخين كما في شيت "الأنشطة" والجدول في شيت "تكافؤ الفرص" إلى ملف وورد - يعني بجانب الزرارين الموجودين اللي بيصدرو الى ملف اكسل وملف وورد - عايز رار تالت في الثلاث شيتات دول يحول نتيجة البحث الى ملف بصيغة الوورد

وجزاكم الله الخير الكثير ونفع بكم وزادكم بسطة في العلم يا رب العالمين

مرفق الملف المطلوب

2025.xlsm

[محمد هشام.]

تفضل اخي نفس الفكرة سيتم انشاء مجلد في نفس مسار المصنف باسم ملفات word وحفظ الملفات بداخله 

تمت اظافة الاكواد على الشيتات المطلوبة 

Sub ExcelToWordSheet1()
Dim lr As Long
Dim WS As Worksheet: Set WS = Sheets("Sheet1")
 
 Msg = MsgBox("؟" & " " & "Word " & ":" & " تصدير التقرير بصيغة", vbYesNo, WS.Name)
      If Msg <> vbYes Then Exit Sub

On Error Resume Next
Dim docDest As Word.Document
Dim srcWS As Word.Application
Set srcWS = CreateObject("word.application")
srcWS.Visible = True

xName = "ملفات Word"
XPath = ThisWorkbook.path & "\" & xName
      
lr = WS.Cells(WS.Rows.Count, "A").End(xlUp).Row
 WS.Range("A7: k" & lr).Copy
      
Set docDest = srcWS.Documents.Add
srcWS.Selection.PasteExcelTable _
    LinkedToExcel:=False, WordFormatting:=False, RTF:=False
    Application.CutCopyMode = False
    
srcWS.ActiveDocument. _
   PageSetup.Orientation = wdOrientLandscape
srcWS.ActiveDocument. _
   PageSetup.PaperSize = WdPaperSize.wdPaperA3
  
    If Dir(XPath, vbDirectory) = "" Then MkDir XPath
          docDest.SaveAs XPath & "\" & WS.Name & ".docx"
          
              docDest.Close
            Set docDest = Nothing
       srcWS.Quit
    Set srcWS = Nothing
    MsgBox "Done", vbInformation
End Sub

ملاحظة في حالة قمت بنسخ الاكواد الى ملف اخر لا تنسى تفعيل الخاصية التالية 

 

2025 v2.xlsm

[Alaa Ammar New]

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