Use Excel VBA to add multiple tables to end of Word document

leniusc · Jul 11, 2008

ther; mso-font-pitch:variable; mso-font-signature:0 0 0 0 0 0;} @font-face {font-family:Calibri; panose-1:2 15 5 2 2 2 4 3 2 4; mso-font-charset:0; mso-generic-font-family:swiss; mso-font-pitch:variable; mso-font-signature:-1610611985 1073750139 0 0 159 0;} /* Style Definitions */ p.MsoNormal, li.MsoNormal, div.MsoNormal {mso-style-unhide:no; mso-style-qformat:yes; mso-style-parent:""; margin-top:0in; margin-right:0in; margin-bottom:10.0pt; margin-left:0in; line-height:115%; mso-pagination:widow-orphan; font-size:11.0pt; font-family:"Calibri","sans-serif"; mso-ascii-font-family:Calibri; mso-ascii-theme-font:minor-latin; mso-fareast-font-family:Calibri; mso-fareast-theme-font:minor-latin; mso-hansi-font-family:Calibri; mso-hansi-theme-font:minor-latin; mso-bidi-font-family:"Times New Roman"; mso-bidi-theme-font:minor-bidi;} p.MsoNoSpacing, li.MsoNoSpacing, div.MsoNoSpacing {mso-style-priority:1; mso-style-unhide:no; mso-style-qformat:yes; mso-style-parent:""; margin:0in; margin-bottom:.0001pt; mso-pagination:widow-orphan; font-size:11.0pt; font-family:"Calibri","sans-serif"; mso-ascii-font-family:Calibri; mso-ascii-theme-font:minor-latin; mso-fareast-font-family:Calibri; mso-fareast-theme-font:minor-latin; mso-hansi-font-family:Calibri; mso-hansi-theme-font:minor-latin; mso-bidi-font-family:"Times New Roman"; mso-bidi-theme-font:minor-bidi;} .MsoChpDefault {mso-style-type:export-only; mso-default-props:yes; mso-ascii-font-family:Calibri; mso-ascii-theme-font:minor-latin; mso-fareast-font-family:Calibri; mso-fareast-theme-font:minor-latin; mso-hansi-font-family:Calibri; mso-hansi-theme-font:minor-latin; mso-bidi-font-family:"Times New Roman"; mso-bidi-theme-font:minor-bidi;} .MsoPapDefault {mso-style-type:export-only; margin-bottom:10.0pt; line-height:115%;} @page Section1 {size:8.5in 11.0in; margin:1.0in 1.0in 1.0in 1.0in; mso-header-margin:.5in; mso-footer-margin:.5in; mso-paper-source:0;} div.Section1 {page:Section1;} --> </style> I have an Excel spreadsheet of data that I would like to export into tables in a new word document.
The code below (without the marked section) does this, but I can’t figure out how to create a second table after the first one.
<o

> </o

>
Eventually I will use a For…Next loop to do this many times, but I’m trying to make the problem smaller by just making a second table.
<o

> </o

>
Thank you in advance for any help.
-Chris
<o

> </o

>
Sub CreateNewWordDoc()
' add a reference to the Word-library
Dim wrdApp As Word.Application
Dim wrdDoc As Word.Document
Dim wrdTable As Word.Table
Dim xText
Set wrdApp = CreateObject("Word.Application")
Set wrdDoc = wrdApp.Documents.Add ' create a new document
Set wrdRange = wrdDoc.Range
wrdApp.Visible = True
'Create table
Set wrdTable = wrdDoc.Tables.Add(Range:=wrdRange, NumRows:=1, NumColumns:=2)
xText = Worksheets("Sheet1").[A1].Value
With wrdTable
With .Cell(1, 1).Range
.InsertAfter xText
End With
xText = Worksheets("Sheet1").[A2].Value
With .Cell(1, 2).Range
.InsertAfter xText
End With
End With
'--------------problematic section begins here?--------------
Set wrdTable = wrdDoc.Tables.Add(Range:=wrdRange, NumRows:=1, NumColumns:=2)
xText = Worksheets("Sheet1").[B1].Value
With wrdTable
With .Cell(1, 1).Range
.InsertAfter xText
End With
xText = Worksheets("Sheet1").[B2].Value
With .Cell(1, 2).Range
.InsertAfter xText
End With
End With
'----------------------------
'clean up
Set wrdDoc = Nothing
Set wrdApp = Nothing
End Sub
<o

> </o

>

Cindy Ellis · Jan 15, 2012

Hi Krishnan,
When the first picture is added, it may be selected within Word (at least it is when it's pasted in manually). The selection is itself an object within VBA, so we can use "Range:=.Range", in which the dot in ".Range" indicates it's part of the object in a "With..." block to manipulate the selection and insertion point. This ensures that the table is added at the right spot.

Dissecting "Set rngTable = wrdTable.Cell(1, i).Range":

"Set" is used to assign a variable name to an object
"rngTable" is the name of the variable. It could be any name.
"wrdTable" is the variable name assigned to the table that was just added.
".Cell(1,i)" identifies a cell within the table.
"1" indicates the cell is on the first row.
"i" is the column in the table. It's a variable that gets incremented each time the code goes through the "For...Next" loop, so the column that's being pointed to is 1 the first time, 2 the second time, etc.
".Range" as part of the assignment tells word that we're working with the insertion point in the cell, not it's borders, color, etc.

Hope that helps,

krinsn · Jan 15, 2012

Thanks a lot

Regards

krishnan

krinsn · Feb 1, 2012

Hi CINDY,

How are you..

I in the previous,thread had asked about copying data from an excel workbook with multiple worksheets to a new word document..Now I am trying to do the same on to an existing word documents specific pages.

I will have the word document and the excel workbook mentioned previously open.
The macro in the word document should move the data in each sheet (Data will be pictures with unique names(Picture 1 to Picture 4) to a specific page in word(6,8,10 and 12).

I tried the following to start with for picture 1:

Sub getdata()
Dim XLApp As Object, ws As Object
Set XLApp = GetObject("", "Excel.application")-->It would be good if i can pinpoint to my excel doc as it will always have the same name.
XLApp.Sheets("Sheet1").Shapes("Picture 1").Copy
XLApp.Selection.Paste
End Sub

Can you please help me on this

vishalt · Feb 6, 2013

Cindy,

I have multiple excel files in a same folder with same format.

I want to read these files and want to create word document file for each row with specific format.

We have checked the possibility that we could open a closed file, read it and create multiple file for each row.

But, I don't want to open each and every macro and run it. Instead of that i will run Macro from any excel file present in the same folder and it will read other files one by one.

Please help me on this.

Regards,
Vishy

Cindy Ellis said:

Hi leniusc,
Welcome to the Board!
Your code just needed some minor tweaking to work...basically you needed to collapse the range to the end, then (assuming that you want a paragraph between tables) insert a paragraph after the table, and again collapse the range to the end before adding the second (and subsequent) tables:

Code:

Sub CreateNewWordDoc()
' add a reference to the Word-library
    Dim wrdApp As Word.Application
    Dim wrdDoc As Word.Document
    Dim wrdTable As Word.Table
    Dim xText
    Set wrdApp = CreateObject("Word.Application")
    Set wrdDoc = wrdApp.Documents.Add ' create a new document
    Set wrdRange = wrdDoc.Range
    wrdApp.Visible = True
    'Create table
    Set wrdTable = wrdDoc.Tables.Add(Range:=wrdRange, NumRows:=1, NumColumns:=2)
    xText = Worksheets("Sheet1").[A1].Value
    With wrdTable
        With .Cell(1, 1).Range
            .InsertAfter xText
        End With
        xText = Worksheets("Sheet1").[A2].Value
        With .Cell(1, 2).Range
            .InsertAfter xText
        End With
    End With
    
    '------new code-----------
    wrdRange.Collapse Direction:=wdCollapseEnd
    With wrdRange
        .Collapse Direction:=wdCollapseEnd
        .InsertParagraphAfter
        .Collapse Direction:=wdCollapseEnd
    End With
        
    '--------------no longer a problem--------------
    Set wrdTable = wrdDoc.Tables.Add(Range:=wrdRange, NumRows:=1, NumColumns:=2)
    xText = Worksheets("Sheet1").[B1].Value
    With wrdTable
        With .Cell(1, 1).Range
            .InsertAfter xText
        End With
        xText = Worksheets("Sheet1").[B2].Value
        With .Cell(1, 2).Range
            .InsertAfter xText
        End With
    End With
    '----------------------------
    'clean up
    Set wrdDoc = Nothing
    Set wrdApp = Nothing
End Sub

Assuming that your tables are bigger than 2 columns by 1 row in real life, you might also consider using copy/paste an entire range from Excel to Word within your macro...it seems a bit simpler (to me) than exporting cell-by-cell.

Hope this helps,
Cindy

Cindy Ellis · Feb 6, 2013

Hello, and Welcome to Mr. Excel!
Here's a macro I use to process all of the files in a folder, one after another. You put the instructions for each individual file after the line that says "your code here"

Code:

[FONT=Verdana]Sub ProcessFilesInFolder()[/FONT]
[FONT=Verdana]Dim folderName As String, filePathName As String, NextFile As String[/FONT]
[FONT=Verdana]Dim WBName As String, DSName As String[/FONT]

[FONT=Verdana]folderName = "C:\temp\" 'Change this to your directory[/FONT]
[FONT=Verdana]NextFile = Dir(folderName & "*.csv", vbNormal)[/FONT]

[FONT=Verdana]While NextFile <> ""[/FONT]

[FONT=Verdana]filePathName = folderName & NextFile[/FONT]
[FONT=Verdana]Workbooks.Open FileName:=filePathName[/FONT]

[FONT=Verdana]WBName = ActiveWorkbook.Name 'use WBName to refer to the name of the current workbook[/FONT]
[FONT=Verdana]DSName = ActiveSheet.Name 'use DSName to refer to the name of the worksheet[/FONT]
[FONT=Verdana]'that was created when you opened the text file[/FONT]

[FONT=Verdana]'***********your code here*************[/FONT]

[FONT=Verdana]'do whatever you need to do to the file here.[/FONT]
[FONT=Verdana]MsgBox (WBName) 'this is just for testing...remove it when you know you're getting the files you want[/FONT]


[FONT=Verdana]'***********end of your code here*************[/FONT]


[FONT=Verdana]Workbooks(WBName).Close SaveChanges:=True[/FONT]

[FONT=Verdana]NextFile = Dir() 'this gets the name of the next file[/FONT]

[FONT=Verdana]Wend[/FONT]


[FONT=Verdana]End Sub[/FONT]

Hope that helps,

Cindy

crb9001 · Sep 25, 2014

Hi Cindy;

This is so close to what I'm trying to do, but I just can't seem to get it right. I am actually generating a Word document from Access but often find the same code that works in Excel will work in Access. What I need to do is copy and paste a new table for each year beyond the first year of a contract for this report. I don't want to create the table from scratch because they are very particular about the formatting, so I just want to copy it. The problem I'm having is inserting a paragraph mark between tables, so they keeping ending up collapsed together. Here is my code (I would do this inside a loop that would track the number of tables added, then go back and populate the tables with data. Lines that I've commented out are things I've tried but didn't work.)

Dim rngCurr As Object
dReport.tables(intTable).range.copy
Set rngCurr = dReport.Goto(what:=wdGoToBookmark, Name:="ContractCostTables")
rngCurr.InsertAfter vbCrLf
dReport.tables(intTable).range.collapse m_wdCollapseEnd 'the m_ is because I'm using late binding, so I have recreated these constants in my module

'dReport.tables(intTable).range.insertparagraphAfter
'dReport.tables(intTable).range.collapse m_wdCollapseStart
dReport.tables(intTable).range.paste

Any help will be greatly appreciated! Thanks

Cheryl

Cindy Ellis · Sep 25, 2014

When you insert a paragraph at the end of a table, Word creates a new row, so you aren't able to "break out of the table". Try using "Selection.SplitTable" right after the "insertparagraphAfter".
Hope that helps,

crb9001 · Sep 26, 2014

Cindy;

Thank you for your reply but I have not had success trying to access the Selection object from an application other than Word and I'm trying to keep all of this within Access so that I don't have to make the template macro enabled.

It appears that the SplitTable method is only available from the Selection object so I'll keep looking for a solution.

Thanks again
Cheryl

Cindy Ellis said:
When you insert a paragraph at the end of a table, Word creates a new row, so you aren't able to "break out of the table". Try using "Selection.SplitTable" right after the "insertparagraphAfter".
Hope that helps,

crb9001 · Sep 29, 2014

Here's how I was finally able to solve the problem thanks to a coworker.

Dim dReport as Document
Dim rngCurr as Range

'Copy the desired table
dReport.tables(intTable).range.copy
'Set a range = to the table range you copied
Set rngCurr = dReport.tables(intTable).range

rngCurr.start = rngCurr.end + 1

rngCurr.InsertParagraphAfter
rngCurr.paste

crb9001 said:
Cindy;

Thank you for your reply but I have not had success trying to access the Selection object from an application other than Word and I'm trying to keep all of this within Access so that I don't have to make the template macro enabled.

It appears that the SplitTable method is only available from the Selection object so I'll keep looking for a solution.

Thanks again
Cheryl

kentran73 · Feb 8, 2015

Hi Cindy,
I am using microsoft office 2011 for Mac. My task is copying tables from excel and paste them at the end of given microsoft word. Below is my code. it got the run time error code '4605': The object is not available at the "wdApp.Selection.PasteExcelTable False, False, False" line. I can see the word file was opened. I believe the selection was copied to the clipboard but i don't know why it couldn't be pasted to the word file.
Thank you in advance for your help. -Ken

My sample code:
Public Const filename1 As String = "demo2.docx"
Sub excel2word()

Dim wdApp As Object
Dim wd As Object

Dim wdFind As Object
Dim ClipEmpty As New MSForms.DataObject
Dim ClipT As String

On Error Resume Next
Set wdApp = GetObject(, "Word.Application")
BlnWordAppOpen = True
If Err.Number <> 0 Then
Set wdApp = CreateObject("Word.Application")
End If

On Error GoTo 0
If Sample(filename1) = 1 Then
Set wd = wdApp.Documents.Open(ActiveWorkbook.Path & ":" & filename1)

Else
Set wd = wdApp.Documents.Add
End If
Set wdFind = wdApp.Selection.Find
wdApp.Visible = True

Sheets("SOC").Select
Range("A:A,B:C").Select
Selection.Font.Size = 8
Selection.Copy
wdApp.Activate
wdApp.Selection.PasteExcelTable False, False, False

wd.SaveAs FileName:=filename1, FileFormat:=wdformatdocx

wd.Close
Set wd = Nothing

End Sub

Function Sample(filename1 As String)
MyDir = ActiveWorkbook.Path
strPath = MyDir & ":"

strFile = Dir(strPath, MacID("W8BN"))

'Loop through each file in the folder
Do While Len(strFile) > 0
If strFile = filename1 Then
'If Right(strFile, 4) = "docx" Then
Sample = 1
Exit Do
Else
Sample = 0
End If

strFile = Dir
Loop
End Function

Use Excel VBA to add multiple tables to end of Word document

leniusc

New Member

Cindy Ellis

MrExcel MVP

Excel Facts

krinsn

New Member

krinsn

New Member

vishalt

New Member

Cindy Ellis

MrExcel MVP

crb9001

New Member

Cindy Ellis

MrExcel MVP

crb9001

New Member

crb9001

New Member

kentran73

New Member

Similar threads

Forum statistics

Share this page

Use Excel VBA to add multiple tables to end of Word document

New Member

MrExcel MVP

Excel Facts

New Member

New Member

New Member

MrExcel MVP

New Member

MrExcel MVP

New Member

New Member

New Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock