CODEWITHSUNDEEP
excelvbams-word
TryHarder
TryHarder

Reputation: 750

VBA MS Word table creating

I am trying to setup a table that embeds another table and fill it in from Excel (mailmerger). I am struggling to jump from cells to cells in Word, could someone give me some idea where to start?

 -------------------
 | Text in Cell1    |
 |------------------|
 |  --------------  |
 |  | Text newtbl | |
 |  |-------------| |
 |  |Text again   | |
 |  --------------  |
 --------------------

A code that I tried to combine but only add stuff in the first cell.

Sub test()
Dim objWord As Object 'a new instance of Word
    Dim objDoc As Object    'our new Word document


    Set objWord = CreateObject("Word.Application")
    objWord.Visible = True
    Set objDoc = objWord.Documents.Add(DocumentType:=0)
    objDoc.PageSetup.PageWidth = objWord.CentimetersToPoints(10.5)
    objDoc.PageSetup.PageWidth = objWord.CentimetersToPoints(14.8)

    objWord.Activate

    Dim objTbl1 As Object
    Set objTbl1 = objDoc.Tables.Add(Range:=objDoc.Paragraphs(1).Range, NumRows:=2, NumColumns:=1)
    Set objRow1 = objTbl1.Rows(1)
    objRow1.Range.Text = "Feb 2019"
    Set objRow1 = objTbl1.Rows(2)
    Dim objTbl2 As Object
    Set objTbl2 = objDoc.Tables.Add(Range:=objDoc.Paragraphs(1).Range.InsertAfter, NumRows:=8, NumColumns:=1)
    Set objRow2 = objTbl2.Rows(1)
    objRow1.Range.Text = "Sunday"
    Set objRow2 = objTbl2.Rows(2)
    objRow1.Range.Text = " "
    Set objRow2 = objTbl2.Rows(3)
    objRow1.Range.Text = "Monday"
    Set objRow2 = objTbl2.Rows(4)
    objRow1.Range.Text = " "
    Set objRow2 = objTbl2.Rows(5)
    objRow1.Range.Text = "Tuesday"
    Set objRow2 = objTbl2.Rows(6)
    objRow1.Range.Text = " "
    Set objRow2 = objTbl2.Rows(7)
    objRow1.Range.Text = "Wednesday"
    Set objRow2 = objTbl2.Rows(8)
    objRow1.Range.Text = " "
End Sub

Upvotes: 0

Views: 98

Answers (2)

Asger
Asger

Reputation: 3877

Please see this little experiment including Range, Row, Column and Cell objects:

Private Sub Test()
    Dim objword As Word.Application
    Dim objDoc As Word.Document
    Dim objRange As Word.Range
    Dim objTbl1 As Word.Table, objTbl2 As Word.Table
    Dim objRow As Word.Row
    Dim objCell As Word.Cell

    Set objword = CreateObject("Word.Application")
    objword.Visible = True
    Set objDoc = objword.Documents.Add(DocumentType:=0)
    objDoc.PageSetup.PageWidth = objword.CentimetersToPoints(10.5)
    objDoc.PageSetup.PageWidth = objword.CentimetersToPoints(14.8)

    objword.Activate

    Set objTbl1 = objDoc.Tables.Add(Range:=objDoc.Paragraphs(1).Range, NumRows:=2, NumColumns:=1)

    ' Just to explain "For Each Cell":
    For Each objCell In objTbl1.Rows(1).Cells
        objCell.Range.Text = "Feb 2019"
    Next objCell

    ' Range (to be collapsed to add a larger table within cell)
    Set objRange = objTbl1.Columns(1).Cells(2).Range
    objRange.Collapse (wdCollapseStart)
    Set objTbl2 = objDoc.Tables.Add(Range:=objRange, NumRows:=8, NumColumns:=1)

    With objTbl2.Columns(1)
        .Cells(1).Range.Text = "Sunday"
        .Cells(2).Range.Text = "Monday"
    End With

End Sub

Upvotes: 1

Ahmed AU
Ahmed AU

Reputation: 2777

Why not try like This

Sub test()
Dim objWord As Word.Application 'a new instance of Word
Dim objDoc As Document    'our new Word document

    Set objWord = CreateObject("Word.Application")
    objWord.Visible = True
    Set objDoc = objWord.Documents.Add(DocumentType:=0)
    objDoc.PageSetup.PageWidth = objWord.CentimetersToPoints(10.5)
    objDoc.PageSetup.PageWidth = objWord.CentimetersToPoints(14.8)

    objWord.Activate

    Dim objTbl1  As Table
    Set objTbl1 = objDoc.Tables.Add(Range:=objDoc.Paragraphs(1).Range, NumRows:=3, NumColumns:=1)
    objTbl1.Cell(1, 1).Range.Text = "Feb 2019"
    objTbl1.Cell(2, 1).Range.Text = " "
    Dim objTbl2 As Table
    Set objTbl2 = objTbl1.Cell(2, 1).Tables.Add(Range:=objTbl1.Cell(2, 1).Range, NumRows:=8, NumColumns:=1)

    For i = 1 To 8
    objTbl2.Cell(i, 1).Range.Text = "Day" & i
    Next i

End Sub

Upvotes: 1

Related Questions