CFrasnelly
asked on
Word 2007 Automation - Adding Multiple Tables using VBA
Hi all,
I'm trying to add multiple tables to a word document. The first table works fine but I cannot get any further tables added properly... any help would be appreciated. Code is attached. I assumed I would create a table then move to the end of the document then create another table etc.
I'm trying to add multiple tables to a word document. The first table works fine but I cannot get any further tables added properly... any help would be appreciated. Code is attached. I assumed I would create a table then move to the end of the document then create another table etc.
'*****EARLY BINDING
Dim objWord As Word.Application
Dim objDoc As Word.Document
Dim objTable As Word.Table
Dim objRange As Word.Range
'Create Word Instance
Set objWord = New Word.Application
'Create doc
Set objDoc = objWord.Documents.Add
objWord.Visible = True
objWord.Activate
'*****END EARLY BINDING -
'START TYPING
objWord.Selection.Font.Bold = True
objWord.Selection.TypeText "Projects"
objWord.Selection.TypeParagraph
'***Add Header
'***Add Projects*********************************************************************
rst.Open "SELECT Name, Start_Date FROM tblProject WHERE Plan_Year = 2010 AND FKEYProjectType=1 ORDER BY Name ASC", CurrentProject.Connection, adOpenKeyset, adLockOptimistic
i = rst.RecordCount
'Create Table
Set objRange = objWord.Selection.Range
Set objTable = objDoc.Tables.Add(objRange, i + 1, 3)
'Setup Table properties
With objTable
.AllowAutoFit = True
.AutoFitBehavior wdAutoFitContent
.BottomPadding = 0
.TopPadding = 0
.Rows.SetHeight 13, wdRowHeightExactly
.Range.Font.Bold = False
' .Columns(3).SetWidth 0.2, wdAdjustNone
End With
'Load Values into the table
objTable.Cell(1, 1).Range.InsertAfter "PROJECT NAME"
objTable.Cell(1, 2).Range.InsertAfter "START DATE"
With objWord.Selection.Font
.Bold = True
.Size = 9
End With
While Not rst.EOF
For x = 1 To i
objTable.Cell(x + 1, 1).Range.InsertAfter x & ") " & rst.Fields("Name")
objTable.Cell(x + 1, 2).Range.InsertAfter Nz(rst.Fields("Start_Date"), "NO START")
rst.MoveNext
Next x
Wend
'ADD NEXT TABLE - Move to the end of the document to add the next table
objWord.ActiveDocument.Characters.Last.Select
objWord.Selection.Collapse
With objRange
.Collapse Direction:=wdCollapseEnd
.MoveEnd
.InsertParagraphAfter
.Collapse Direction:=wdCollapseEnd
End With
'***Add Road Construction
rst.Close
rst.Open "SELECT Name FROM tblVendor WHERE IsRoadSide = 1 ORDER BY Name ASC", CurrentProject.Connection, adOpenKeyset, adLockOptimistic
i = rst.RecordCount
'Create Table
Set objTable = objDoc.Tables.Add(objRange, i + 1, 2)
'Setup Table properties
With objTable
.AllowAutoFit = True
.AutoFitBehavior wdAutoFitContent
.BottomPadding = 0
.TopPadding = 0
.Rows.SetHeight 13, wdRowHeightExactly
.Range.Font.Bold = False
' .Columns(3).SetWidth 0.2, wdAdjustNone
End With
'Load Values into the table
objTable.Cell(1, 1).Range.InsertAfter "Road Side"
objTable.Cell(1, 2).Range.InsertAfter "Notes"
With objWord.Selection.Font
.Bold = True
.Size = 9
End With
While Not rst.EOF
For x = 1 To i
objTable.Cell(x + 1, 1).Range.InsertAfter x & ") " & rst.Fields("Name")
rst.MoveNext
Next x
Wend
ASKER
That didn't work... although it did extend the first table?????
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
It works!!! With one strange bug (there's always something isn't there) ... It goes back and deletes almost the entire contents of the first cell in the first table....
Just figured it out... I needed to remove the below code... the .InsertParagraphAfter command was destroying it. Thanks for your help on this Chris!!!
'objWord.Selection.Collaps e
' With objRange
' .Collapse Direction:=wdCollapseEnd
' .MoveEnd
' .InsertParagraphAfter
' .Collapse Direction:=wdCollapseEnd
' End With
Just figured it out... I needed to remove the below code... the .InsertParagraphAfter command was destroying it. Thanks for your help on this Chris!!!
'objWord.Selection.Collaps
' With objRange
' .Collapse Direction:=wdCollapseEnd
' .MoveEnd
' .InsertParagraphAfter
' .Collapse Direction:=wdCollapseEnd
' End With
ASKER
Very helpful!!!!
objDoc.Application.Selecti
Set objTable = objDoc.Tables.Add(objDoc.A
Basically it does two things - adds a paragraph to disconnect from the previous table and replaces the ref to objrange which hasn't changed for the new table to be the end of the document where you placed the cursor.
Chris
Open in new window