通过Excel 2010 VBA将表添加到Word文档

Question

我目前正在尝试比较两个Excel文档之间的数字，并将测试结果写入Word文档中的表中。 我已经能够建立到文档的连接，但是我无法实际添加表来工作。

这就是我所拥有的：

Dim wordObj As Object
Dim outFile As Object

On Error Resume Next
Set wordObj = GetObject(, "Word.Application")

If wordObj Is Nothing Then
    Set wordObj = CreateObject("Word.Application")
End If

Set outFile = wordObj.Documents.Add

wordObj.Visible = True
wordObj.Tables.Add Range:=wordObj.Selection.Range, NumRows:=1, NumColumns:=3

wordObj.Selection.Tables(1).Select

With wordObj.Selection
        .TypeText ("test1")
        .MoveRight (wordObj.wdCell)
        .TypeText ("test2")
        .MoveRight (wordObj.wdCell)
        .TypeText ("test3")
        .MoveLeft (wordObj.wdCell)
        .MoveLeft (wordObj.wdCell)
        .MoveDown Unit:=wordObj.wdLine, Count:=1        
End With

我也尝试过将页面分为3列，但确实可行，但是我无法在想要的时候让程序在各列之间进行实际切换（我尝试使用InsertBreak（wdColumnBreak））。 因此出于某种原因，添加列是可行的，但是表却不能

Answer 1

Tables.Add的问题在于，您在错误的对象上调用它，而且它是单词document的方法，因此无论它是什么，都期望“单词范围”。 这是一段有效的代码，但是它将表复制并粘贴到上面：

Sub aaa()
    Dim wordObj As New Word.Application
    Dim outFile As Word.Document
    Dim s As Worksheet
    Dim r As Range

    wordObj.Visible = True
    Set outFile = wordObj.Documents.Add
    outFile.Activate

    Debug.Print "Here!"

    Set s = ActiveWorkbook.Sheets("Sheet1")
    Call s.Range("E4:J10").Copy
    ' Call outFile.Tables.Add(wordObj.ActiveDocument.Range(0, 0), NumRows:=3, NumColumns:=3)
    Call wordObj.ActiveDocument.Range(0, 0).Paste
End Sub

Answer 2

您的代码缺乏精度。 您应该尝试更系统地构建它，例如，首先创建Word应用程序的实例。 然后，让该应用程序创建一个文档。 然后将表格放到该文档中。 然后在该表中查找一个单元格。 并仅将文本添加到该单元格。

相比之下，您创建Word应用程序，不创建任何文档，向该文档中添加一个不存在的表，并且-大概是在绝望中-然后尝试向该应用程序中添加文本。 Word应用程序没有选择（您的wordObj.Selection ），只有文档有。

以下代码可以满足您的需求。 为了您的理解，我写了它。 不要以为是“婴儿语言”，因为它不是。 它只是不会偷工减料。 如果您仍然愿意，可以学习精通技巧。 请记住，切入的角越多，代码的稳定性就越差。

Sub WriteToWordTable()

    ' declarations for the Excel application:
    Dim Ws As Worksheet

    ' declarations for the Word application:
    Dim wordObj As Word.Application
    Dim outFile As Word.Document
    Dim outTable As Word.Table
    Dim wdRng As Word.Range

    Set Ws = ActiveSheet
    Ws.Cells(2, "A").value = "Test1"

    On Error Resume Next
    Set wordObj = GetObject(, "Word.Application")

    If wordObj Is Nothing Then
        Set wordObj = CreateObject("Word.Application")
    End If

    Set outFile = wordObj.Documents.Add
    With outFile
        Set wdRng = .Range(0, 0)
        Set outTable = .Tables.Add(Range:=wdRng, _
                                   NumRows:=1, NumColumns:=3)
    End With

    With outTable
        .Cell(1, 1).Range.Text = Ws.Cells(2, "A").value
        .Rows.Add
        .Cell(2, 1).Range.Text = "Test2"
    End With

    With wordObj.ActiveWindow
        .Visible = True
        .Activate
    End With

'    outFile.Close
'    wordObj.Quit
End Sub

顺便说一句，您不需要随时使Word文档可见。 您可以安静地关闭Word应用程序，然后继续在Excel中工作。 但是，为此，您需要先保存outFile ，然后再关闭它，然后关闭Word。