Создание таблицы VBA MS Word

Question

Я пытаюсь настроить таблицу, в которую встроена другая таблица, и заполнить ее из Excel (mailmerger).Я изо всех сил пытаюсь перейти из одной ячейки в другую в Word. Может, кто-нибудь подскажет, с чего начать?

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

Код, который я пытался объединить, но добавил только элементы в первой ячейке.

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

Answer 1

Пожалуйста, посмотрите этот маленький эксперимент, включающий объекты Range, Row, Column и Cell:

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

Answer 2

Почему бы не попробовать вот так

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