I am just referencing some sample code ,that want to move An Excel table Into A new word document.
However , it contains at least one error .
Set tbl = ThisWorkbook.Worksheets(Sheet9.Name).ListObjects("Table1").Range
Error: Need object here.
Link :
https://www.thespreadsheetguru.com/blog/2014/5/22/copy-paste-an-excel-table-into-microsoft-word-with-vba
Full codes:
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
Based on the information you supplied in comments, it appears you don't actually have a table in your worksheet (which is why ListObjects("Table1") wasn't returning an object) and you actually just want to transfer a Range.
If so, replace the line setting tbl with something like:
Set tbl = ThisWorkbook.Worksheets("whatever_sheet_name_you_are_using").Range("A1:E10")
Related
Sub exceltoword()
'PURPOSE: Copy/Paste An Excel Table Into a New Word Document
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(1).Range("A:E")
'Update colums width
Columns("A").ColumnWidth = 5
Columns("B:E").ColumnWidth = 25
'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
This is my current VBA code, I am trying to copy, paste and excel pivot table in sheet1 to MS.Word. I am struggle in how to remove blank in Excel pivot table and makes the Word format read friendly. Below is my current output screenshot, many thanks.
enter image description here
I wish I could just copy straight from excel but the program that I am copying into doesn't allow that.
This is what I have so far.
Sub exceltoword()
Dim RangeToCopy As Range
Set RangeToCopy = Range("A2")
Dim WordApp As Word.Application
Set WordApp = New Word.Application
WordApp.Visible = True
Dim WordDoc As Word.Document
Set WordDoc = WordApp.Documents.Add
RangeToCopy.Copy
WordDoc.Words(1).PasteExcelTable False, False, False
ActiveDocument.Paragraphs(1).Range.Copy
Application.Wait (Now + TimeValue("0:00:001"))
WordDoc.Close
WordApp.Quit
Set WordDoc = Nothing
Set WordApp = Nothing
Application.Wait (Now + TimeValue("0:00:005"))
Set RangeToCopy = Range("B2")
Set WordApp = New Word.Application
WordApp.Visible = True
Set WordDoc = WordApp.Documents.Add
RangeToCopy.Copy
WordDoc.Words(1).PasteExcelTable False, False, False
Application.Wait (Now + TimeValue("0:00:001"))
ActiveDocument.Paragraphs(1).Range.Copy
Application.Wait (Now + TimeValue("0:00:001"))
ActiveDocument.Close SaveChanges:=wdDoNotSaveChanges
End Sub
With a simple google search of how to copy from excel to word is where I found the below, I added comments that tell you where to change variables, you can add multiple tables pasted to any bookmarks you set in word, make sure you set your references.
your code will look something like this after you declare you word application
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("MAKE YOUR TABLE ARRAY IN EXCEL AND PUT THE NAME HERE",)
'List of Word Document Bookmarks (To Paste To - in word goto Insert->Bookmark)
BookmarkArray = Array("BOOKMARK NAME FROM MICROSOFT WORD DOC HERE")
'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("FULL FILE PATH TO YOUR WORD DOCUMENT")
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
Basically you set your variables to the word application, define the arrays you want to paste in your excel sheet (in your instance B5?) then it will loop through and paste your arrays to the Bookmarks you set in your word document, which you can set to any location in your word document.
I have copied some sample code from the Internet.
I want to copy the table on Excel into a new word document.
Here is my code:
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 'was highlighted as error .
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
It contains at least one error, because it just runs from the beginning:
Dim WordApp As Word.Application 'was highlighted as error .--> haven't defined the variable
You are missing reference.
To fix this:
Click on Tools to select References Scroll down till you find
“Microsoft Word 15.0 Object Library” Make sure you check the box;
Source: Copy worksheet information to Word using VBA in Microsoft Excel
I have two ranges in the excel file .
(A79-I84) & (A90-I92)
I am now using the Excel.RANGE.copy. to copy the two tables and paste on the word file .
However , the two ranges become two separate tables and the original excel table format cannot inherit to the new word file .Also , some cells from the word report will be shown in two lines .
In conclusion , the format of the word report will be very messy .
How to integrate the two table into one table with good table format or alignments?
the new table will be generated like this :
(red pen = problems )
My codes:
Sub ExcelRangeToWord()
Dim tbl0 As Excel.RANGE
Dim tbl As Excel.RANGE
Dim tbl2 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 tbl0 = ThisWorkbook.Worksheets(sheet9.Name).RANGE("A78:I83")
Set tbl = ThisWorkbook.Worksheets(sheet9.Name).RANGE("A78:I83")
Set tbl2 = ThisWorkbook.Worksheets(sheet9.Name).RANGE("A90:I92")
'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
'Trigger copy separately for each table + paste for each table
tbl.Copy ' paste range1
myDoc.Paragraphs(1).RANGE.PasteExcelTable _
LinkedToExcel:=False, _
WordFormatting:=True, _
RTF:=False
'before that...
'...go to end of doc and add new paragraph
myDoc.Bookmarks("\EndOfDoc").RANGE.InsertParagraphAfter
tbl2.Copy 'paste range2
'Paste Table into MS Word last paragraph
myDoc.Paragraphs(myDoc.Paragraphs.Count).RANGE.PasteExcelTable _
LinkedToExcel:=False, _
WordFormatting:=True, _
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
new aftereffect
Try the following. Simply hide rows in between (which ever you don't want to see) and copy as one range to be from "A79:I92" and paste as a picture. Credit here (#sneep) for sub to resize image. Note this will resize all images but could be adapted to target just one.
Option Explicit
Sub ExcelRangeToWord()
Dim tbl0 As Excel.Range
Dim Tbl As Excel.Range
Dim tbl2 As Excel.Range
Dim wordApp As Word.Application
Dim myDoc As Word.Document
Dim WordTable As Word.Table
Dim wb As Workbook
Dim ws As Worksheet
Set wb = ThisWorkbook
Set ws = wb.Worksheets("Sheet2") ' Change e.g. sheet9.Name
'Optimize Code
Application.ScreenUpdating = False
Application.EnableEvents = False
ws.Rows("84:89").EntireRow.Hidden = True 'ADJUST AS APPROPRIATE
'Copy Range from Excel
'Set tbl0 = ws.RANGE("A78:I83")
Set Tbl = ws.Range("A78:I92")
' Set tbl2 = ws.Range("A90:I92")
'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
'Trigger copy separately for each table + paste for each table
Tbl.CopyPicture Appearance:=xlScreen, Format:=xlPicture
wordApp.Selection.Paste
wordApp.Selection.TypeParagraph
wordApp.Selection.PageSetup.Orientation = wdOrientLandscape
resize_all_images_to_page_width myDoc
EndRoutine:
'Optimize Code
Application.ScreenUpdating = True
Application.EnableEvents = True
'Clear The Clipboard
Application.CutCopyMode = False
End Sub
Sub resize_all_images_to_page_width(myDoc As Document)
'https://blog.qiqitori.com/?p=115
Dim inline_shape As InlineShape
Dim percent As Double
For Each inline_shape In myDoc.InlineShapes
inline_shape.LockAspectRatio = msoFalse
inline_shape.ScaleWidth = 100
inline_shape.ScaleHeight = 100
percent = myDoc.PageSetup.TextColumns.Width / inline_shape.Width
inline_shape.ScaleWidth = percent * 100
inline_shape.ScaleHeight = percent * 100
Next
End Sub
I know this error has been defined in earlier posts for e.g. here. I am pretty new to VBA and do not really understand the explanation there.
I am using the following code to automate adding multiple tables to a word document by bookmarking them as explained in the link http://www.thespreadsheetguru.com/blog/2014/10/5/multiple-tables-to-word-with-vba.I am getting a Subscript out of range (error 9)
The tables are created in the same sheet manually by myself by selecting a particular range in the excel sheet.
Here below you can find the code. I would really be grateful if someone can identify where I am going wrong.
Thank you very much in advance.
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("Siko_LEFIS_v0.1.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
tbl = ThisWorkbook.Worksheets(x).ListObjects(TableArray(x)).Range '####Here is where i get the subbscipt out of range error#######
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 'Siko_LEFIS_v0.1.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
The code below (some slight tweaks for my environment) worked for me. Most likely cause of your error was that you don't have a table with the expected name on one of your sheets.
You were also missing Set on that line (required when assigning a value to an object variable)
Option Explicit
Option Base 1 'Force arrays to start at 1 instead of 0
Sub ExcelTablesToWord()
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
Dim x As Long, sht As Worksheet
TableArray = Array("Table1", "Table2")
BookmarkArray = Array("Bookmark1", "Bookmark2")
Application.ScreenUpdating = False
Application.EnableEvents = False
On Error GoTo WordDocNotFound
Set WordApp = GetObject(class:="Word.Application")
WordApp.Visible = True
Set myDoc = WordApp.Activedocument
'Set myDoc = WordApp.Documents("Siko_LEFIS_v0.1.docx")
On Error GoTo 0
For x = LBound(TableArray) To UBound(TableArray)
Set sht = ThisWorkbook.Worksheets(x)
Set tbl = sht.ListObjects(TableArray(x)).Range
myDoc.Bookmarks(BookmarkArray(x)).Range.PasteExcelTable _
LinkedToExcel:=False, _
WordFormatting:=False, _
RTF:=False
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 'Siko_LEFIS_v0.1.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
I would also recommend that you try to avoid using the Option Base 1 setting: it might appear to make dealing with arrays easier, but changing the default array behavior causes more problem than it solves.