holykimura
New Member
- Joined
- Apr 29, 2012
- Messages
- 24
Hi i have been using the below code to take tables from Excel and paste them into several word documents, however the formatting is out in word and doesn't match the sizes in Excel. My question is what is the code I need to add in below to be able to format the tables once they are copied?
I have tried using this code from an earlier attempt where i was copying one table from excel to one word document and that formatting works fine, but it didn't work in the new one because it didn't recognize the table object:
I appreciate any help i can get thanks
Code:
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 SheetsArray As Variant
Dim BookmarkArray As Variant
Dim ws As Worksheets
'List of Table Names (To Copy)
TableArray = Array("Table1", "Table2", "Table4", "Table3", "Table5")
'List of Word Document Bookmarks (To Paste To)
BookmarkArray = Array("Text1", "Text2", "Text3", "Text4", "Text5")
SheetsArray = Array("Sheet4", "Sheet5", "Sheet3", "Sheet6", "Sheet8")
'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.Open("N:\test2.docx")
On Error GoTo 0
'Make MS Word Visible and Active
WordApp.Visible = True
WordApp.Activate
'Loop Through and Copy/Paste Multiple Excel Tables
For x = LBound(TableArray) To UBound(TableArray)
'Copy Table Range from Excel
Set tbl = ThisWorkbook.Worksheets(SheetsArray(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
I have tried using this code from an earlier attempt where i was copying one table from excel to one word document and that formatting works fine, but it didn't work in the new one because it didn't recognize the table object:
Code:
myDoc.Paragraphs(6).Range.PasteExcelTable _
LinkedToExcel:=True, _
WordFormatting:=False, _
RTF:=False
For i = 1 To myDoc.Tables.Count
myDoc.Tables(2).Cell(1, 1).Range.Font.Size = 8
myDoc.Tables(2).Cell(1, 2).Range.Font.Size = 8
myDoc.Tables(2).Cell(1, 3).Range.Font.Size = 8
myDoc.Tables(2).Cell(1, 4).Range.Font.Size = 8
myDoc.Tables(2).Cell(1, 5).Range.Font.Size = 8
myDoc.Tables(2).Cell(1, 6).Range.Font.Size = 8
myDoc.Tables(2).Cell(1, 7).Range.Font.Size = 8
myDoc.Tables(2).Cell(1, 8).Range.Font.Size = 8
myDoc.Tables(2).Cell(1, 9).Range.Font.Size = 8
myDoc.Tables(2).Cell(1, 10).Range.Font.Size = 8
myDoc.Tables(2).Cell(1, 11).Range.Font.Size = 8
myDoc.Tables(2).Cell(1, 12).Range.Font.Size = 8
myDoc.Tables(2).Cell(1, 13).Range.Font.Size = 8
myDoc.Tables(2).Cell(1, 14).Range.Font.Size = 8
myDoc.Tables(i).Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
myDoc.Tables(i).Select
With Selection
.Font.Bold = False
.Font.Italic = False
.Font.Name = "Calibri"
.Font.Size = "10"
End With
Next i
I appreciate any help i can get thanks
Last edited: