تحويل ورقة اكسل إلى وورد أو Export Excel to word document

[مختار حسين محمود]

بسم الله الرحمن الرحيم

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

 

باختصار مدارس المرحلة الابتدائية غدا فى مصر تجرى اختبار قرائية على مستوى الجمهورية

وقد طلبت الادارات التعليمية من المدارس الابتدائية النتائج على ملف اكسل وورد بالاضافة الى وضع ذلك على النت

 

 طريقة تحويل ملف الاكسل الى الوورد  : الكود المستخدم منقول من الرابط

http://www.thespreadsheetguru.com/blog/2014/5/22/copy-paste-an-excel-table-into-microsoft-word-with-vba

 

وهذه صورة الكود :

Sub ExcelRangeToWord()

'PURPOSE: Copy/Paste An Excel Table Into a New Word Document
'NOTE: Must have Word Object Library Active in Order to Run _
  (VBE > Tools > References > Microsoft Word 12.0 Object Library)
'SOURCE: www.TheSpreadsheetGuru.com

Dim tbl As Excel.Range
Dim WordApp As Word.Application
Dim myDoc As Word.Document
Dim WordTable As Word.Table

'Optimize Code
  Application.ScreenUpdating = False
  Application.EnableEvents = False

'Copy Range from Excel
  Set tbl = ThisWorkbook.Worksheets(Sheet1.Name).ListObjects("Table1").Range

'Create an Instance of MS Word
  On Error Resume Next
    
    'Is MS Word already opened?
      Set WordApp = GetObject(class:="Word.Application")
    
    'Clear the error between errors
      Err.Clear

    'If MS Word is not already open then open MS Word
      If WordApp Is Nothing Then Set WordApp = CreateObject(class:="Word.Application")
    
    'Handle if the Word Application is not found
      If Err.Number = 429 Then
        MsgBox "Microsoft Word could not be found, aborting."
        GoTo EndRoutine
      End If

  On Error GoTo 0
  
'Make MS Word Visible and Active
  WordApp.Visible = True
  WordApp.Activate
    
'Create a New Document
  Set myDoc = WordApp.Documents.Add
  
'Copy Excel Table Range
  tbl.Copy

'Paste Table into MS Word
  myDoc.Paragraphs(1).Range.PasteExcelTable _
    LinkedToExcel:=False, _
    WordFormatting:=False, _
    RTF:=False

'Autofit Table so it fits inside Word Document
  Set WordTable = myDoc.Tables(1)
  WordTable.AutoFitBehavior (wdAutoFitWindow)
  
EndRoutine:
'Optimize Code
  Application.ScreenUpdating = True
  Application.EnableEvents = True

'Clear The Clipboard
  Application.CutCopyMode = False

End Sub

لم يعمل الكود حتى بعد اضافة المكتبة Microsoft Word 12.0 Object Library

 

وقمت بتطويره كما يلى :

Sub ExcelRangeToWord()


'PURPOSE: Copy/Paste An Excel Table Into a New Word Document
'NOTE: Must have Word Object Library Active in Order to Run (VBE > Tools > References > Microsoft Word 12.0 Object Library)
  
'SOURCE: http://www.thespreadsheetguru.com/blog/2014/5/22/copy-paste-an-excel-table-into-microsoft-word-with-vba

Dim tbl As Excel.Range
Dim WordApp As Word.Application
Dim myDoc As Word.Document
Dim WordTable As Word.Table

'Optimize Code
  Application.ScreenUpdating = False
  Application.EnableEvents = False

'Copy Range from Excel
   Set tbl = ThisWorkbook.Worksheets(Sheet1.Name).Range("Table1")

'Create an Instance of MS Word
  On Error Resume Next
    
    'Is MS Word already opened?
      Set WordApp = GetObject(class:="Word.Application")
    
    'Clear the error between errors
      Err.Clear

    'If MS Word is not already open then open MS Word
      If WordApp Is Nothing Then Set WordApp = CreateObject(class:="Word.Application")
    
    'Handle if the Word Application is not found
      If Err.Number = 429 Then
        MsgBox "Microsoft Word could not be found, aborting."
        GoTo EndRoutine
      End If

  On Error GoTo 0
  
'Make MS Word Visible and Active and WindowState Minimize
  WordApp.Visible = True
  WordApp.WindowState = wdWindowStateMinimize
      
'Create a New Document
  Set myDoc = WordApp.Documents.Add
  
  
 
   
'Copy Excel Table Range
  tbl.Copy

'Paste Table into MS Word
  myDoc.Paragraphs(1).Range.PasteExcelTable LinkedToExcel:=False, WordFormatting:=False, RTF:=False
  
  
  'PageSetup into MS Word
   
  With ActiveDocument.PageSetup
        .LineNumbering.Active = False
        .Orientation = wdOrientLandscape
        .TopMargin = CentimetersToPoints(1)
        .BottomMargin = CentimetersToPoints(1)
        .LeftMargin = CentimetersToPoints(1)
        .RightMargin = CentimetersToPoints(1)
       
   End With
 
   

'Autofit Table so it fits inside Word Document
  Set WordTable = myDoc.Tables(1)
  WordTable.AutoFitBehavior (wdAutoFitWindow)
  
 'save Word Document as
  With ActiveDocument
   ChangeFileOpenDirectory (ThisWorkbook.Path)    '  or use this line :   ChangeFileOpenDirectory "H:\ "     * change path
    
   ActiveDocument.SaveAs2 Filename:="document from excel by mohtar.doc"         'change Filename
 End With
 
 'CLOSE Word Application
   With WordApp
     .ActiveDocument.Close
     .Quit
     End With
     Set WordApp = Nothing

EndRoutine:

'Optimize Code
  Application.ScreenUpdating = True
  Application.EnableEvents = True
  
  'Clear The Clipboard
  Application.CutCopyMode = False
  
  
  MsgBox (" congratulation your excel File  saved as to Word Document  ")

End Sub

ملحوظتان فى غاية الأهمية :

الأولى : اضافة المرجع ده   Microsoft Word 12.0 Object Library  لمنع توقف الكود وذلك طبقاً للخطوات الاتية :

VBE > Tools > References > Microsoft Word 12.0 Object Library

 

الثانية تسمية المدى الذى تريد تحويله الى الوورد Table1 

 

والمرفق التالى يوضح ذلك طريقة تحويل الاكسل الى الوورد أقدمه هدية لزملائى ليستفيدوا به فى امتحان القرائية

 

تحياتى للجميع

 

Export Excel to word document.rar

[ياسر خليل أبو البراء]

أخي الحبيب مختار

جزاكم الله خير الجزاء على هذا الملف الرائع إن شاء الله

بقول إن شاء الله عشان لسه مشتغلش معايا كويس

أنا دلوقتي الحمد لله انتقلت لأوفيس 2013 .. والمكتبة اللي أشرت إليها Microsoft Word 12.0 Object Library

اللي عندي 15.0 مفيش مشكلة متفعلة ..!

وجيت أنفذ الكود خد وقت طويـــــــل - المهم صبرت - وصبرت - وفي الآخر جالي رسالة بتقول : الهاتف الذي طلبته غير موجود بالخدمه !!

Microsoft Excel is waiting for another program to complete an OLE action

 

جربت مرة تانية قلت يمكن الكود زعلان من حاجة عندي

وصبرت وصبرت وصبرت ... إنما للصبر حدود أخي مختار على رأي الست

وفي الآخر لسه الكود شغااااااااااال .. حاسس إنه بيخترع الذرة وأخيرا

جاتلي رسالة بتقولي : مبروك جالك ولد (قلت له كنت عايز بنت ) قالي لا جالك ولد ..

الحمد لله تم العمل على خير بس استغرق وقت طويل جداً ..فهل من حل؟

قبل تحياتي

[مختار حسين محمود]

أخى الدكتور ياسر     أعمل ايـــــــــه  والولادة كانت عسرة ؟!

من البنج لحد ما المولود طلع 3  ساعات وأكتر حاولت فى المولود وعطيت اكسجين مفيش فايدة

كان هيموت.منى ونشف دماغه وحلف ما هو نازل  عند السطر  ده :

Set tbl = ThisWorkbook.Worksheets(Sheet1.Name).ListObjects("Table1").Range

مع أنى عامل اسم المدى  Table1 ومفعل المكتبة !!! بس ربنا ستر وأقدرت أطلعه  داهيه تطلع عينه زى ما طلع عينيه

تفتكر ليـــــــــــــــــــــــه يا دكتور ياسر؟!

[ياسر خليل أبو البراء]

كدا إنت حليتها يا أخ مختار

إن المدى يكون جدول بالفعل .. يعني مش تسمي المدى Table1 لا .. تحدد المدى ومن خلال التبويب Insert تختار كلمة Table ليتحول المدى إلى جدول

جرب وشوف

[مختار حسين محمود]

تمام أوى اشتغل الكود الأصلى ولكن البيانات طلعت بشكل  يحتاج  تنسيق وتعديل فى الكود  تحياتى