VBA MS Word表创建

Posted 2021-03-26

我正在尝试设置一个嵌入另一个表的表，并从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

答案

请看这个小实验，包括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

另一答案

为什么不尝试这样

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