Вставка таблицы из нескольких листов Excel в файл слова и имя слова в качестве имени листа VBA

Question

У меня есть файл Excel с большим количеством листов.На каждом листе у меня есть 3 таблицы, которые мне нужно вставить в текстовый документ.Мне нужно создать шаблон слова и назвать его как лист и вставить 2 таблицы.

Sub Separate()

 'Remember: this code requires a referece to the Word object model

 'dimension some local variables
Dim rng As Range 'our source range
Dim wdApp As New Word.Application 'a new instance of Word
Dim wdDoc As Word.Document 'our new Word document
Dim t As Word.Range 'the new table in Word as a range
Dim myWordFile As String 'path to Word template


 'initialize the Word template path
 'here, it's set to be in the same directory as our source workbook
myWordFile = ThisWorkbook.Path & "\DocWithTableStyle.dot"

 'get the range of the contiguous data from Cell A1
Set rng = Range("A1").CurrentRegion
 'you can do some pre-formatting with the range here
rng.HorizontalAlignment = xlCenter 'center align the data
rng.Copy 'copy the range

 'open a new word document from the template
Set wdDoc = wdApp.Documents.Add(myWordFile)

Set t = wdDoc.Content 'set the range in Word
t.Paste 'paste in the table
With t 'working with the table range
    .Style = "GreenBar" 'set the style created for the table
     'we can use the range object to do some more formatting
     'here, I'm matching the table with using the Excel range's properties
    .Tables(1).Columns.SetWidth (rng.Width / rng.Columns.Count), wdAdjustSameWidth
End With

 'until now the Word app has been a background process
wdApp.Visible = True
 'we could use the Word app object to finish off
 'you may also want to things like generate a filename and save the file
wdApp.Activate

End Sub

Это то, что я пытался, но получаю ошибку

---------------------------
Microsoft Visual Basic for Applications
---------------------------
Compile error:

User-defined type not defined
---------------------------
OK   Help   
---------------------------

ссылки на слова и Excel выбраны

Скачать пример файлы.Я не знаю, как кодировать парни, так что не бейте меня слишком сильно)

Answer 1

Примерно так должно получиться.

Option Base 1 'Force arrays to start at 1 instead of 0

Sub ExcelTablesToWord()

'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
Dim TableArray As Variant
Dim BookmarkArray As Variant

'List of Table Names (To Copy)
  TableArray = Array("Table1", "Table2", "Table3", "Table4", "Table5")

'List of Word Document Bookmarks (To Paste To)
  BookmarkArray = Array("Bookmark1", "Bookmark2", "Bookmark3", "Bookmark4", "Bookmark5")

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

'Set Variable Equal To Destination Word Document
  On Error GoTo WordDocNotFound
    Set WordApp = GetObject(class:="Word.Application")
    WordApp.Visible = True
    Set myDoc = WordApp.Documents("Excel Table Word Report.docx")
  On Error GoTo 0

'Loop Through and Copy/Paste Multiple Excel Tables
  For x = LBound(TableArray) To UBound(TableArray)

    'Copy Table Range from Excel
      Set tbl = ThisWorkbook.Worksheets(x).ListObjects(TableArray(x)).Range
      tbl.Copy

    'Paste Table into MS Word (using inserted Bookmarks -> ctrl+shift+F5)
      myDoc.Bookmarks(BookmarkArray(x)).Range.PasteExcelTable _
        LinkedToExcel:=False, _
        WordFormatting:=False, _
        RTF:=False

    'Autofit Table so it fits inside Word Document
      Set WordTable = myDoc.Tables(x)
      WordTable.AutoFitBehavior (wdAutoFitWindow)

  Next x

'Completion Message
  MsgBox "Copy/Pasting Complete!", vbInformation
  GoTo EndRoutine

'ERROR HANDLER
WordDocNotFound:
  MsgBox "Microsoft Word file 'Excel Table Word Report.docx' is not currently open, aborting.", 16

'Put Stuff Back The Way It Was Found
EndRoutine:
'Optimize Code
  Application.ScreenUpdating = True
  Application.EnableEvents = True

'Clear The Clipboard
  Application.CutCopyMode = False

End Sub

Answer 2

Я обновил код, проверил и дал мне знать, если он работает?

Перед запуском макроса перейдите в Microsoft Visual Basic для приложений, окно

, затем в Инструменты-> Ссылки

и проверьте «библиотеку объектов Microsoft Word xx»

и ok

, затем удалите таблицу, вставленную в шаблон, и сохраните ее, так как макрос вставит ее,вам не нужны два из них.

Обновлен макрос

Sub runMacro()

    save_path = ThisWorkbook.Path & "\"

    Call makeDocument("Name 1", save_path)
    Call makeDocument("Name 2", save_path)
    Call makeDocument("Name 3", save_path)

End Sub

Sub makeDocument(sheet_name, save_path)

     'Remember: this code requires a referece to the Word object model

     'dimension some local variables
    Dim rng As Range 'our source range
    Dim wdApp As New Word.Application 'a new instance of Word
    Dim wdDoc As Word.Document 'our new Word document
    Dim t As Word.Range 'the new table in Word as a range
    Dim myWordFile As String 'path to Word template


     'initialize the Word template path
     'here, it's set to be in the same directory as our source workbook
    myWordFile = ThisWorkbook.Path & "/Word Template.docx"

     'get the range of the contiguous data from Cell A1
    'Set rng = Range("A1").CurrentRegion
    Set rng = Sheets(sheet_name).Range("A1:E23")
     'you can do some pre-formatting with the range here
    'rng.HorizontalAlignment = xlCenter 'center align the data
    rng.Copy 'copy the range

     'open a new word document from the template
    Set wdDoc = wdApp.Documents.Add(myWordFile)

    'wdDoc.Paragraphs(2).Range.PasteExcelTable False, False, flase

    Set t = wdDoc.Content 'set the range in Word
    Set t = wdDoc.Paragraphs(2).Range

    t.Paste 'paste in the table
    With t 'working with the table range
        '.Style = "Strong" 'set the style created for the table
        '.Style = "Grid Table 4 - Accent 2"
         'we can use the range object to do some more formatting
         'here, I'm matching the table with using the Excel range's properties
        .Tables(1).Columns.SetWidth (rng.Width / rng.Columns.Count), wdAdjustSameWidth
    End With

     'until now the Word app has been a background process
    wdApp.Visible = True
     'we could use the Word app object to finish off
     'you may also want to things like generate a filename and save the file
    wdApp.Activate

    file_name = save_path & sheet_name 'set the directory where files would be saved

    'save file
    wdDoc.SaveAs2 Filename:=file_name, FileFormat:= _
    wdFormatXMLDocument, LockComments:=False, Password:="", AddToRecentFiles _
    :=True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts _
    :=False, SaveNativePictureFormat:=False, SaveFormsData:=False, _
    SaveAsAOCELetter:=False, CompatibilityMode:=15


End Sub