使用 VBA 将 Excel 中的内容插入 Word 会覆盖之前插入的内容

Question

我在Excel中编写了一个VBA宏，用于从Excel读取数据并在Word中创建文档。 它在“部分”中工作。 当我使用下面的格式说明添加文本时，它可以工作：

objSelection.TypeText lenderAddress & vbCrLf

但是当我创建表格并从单元格数据填充时，早期的文本内容被删除（或覆盖）。 同样的问题出现在表格之后，当我尝试插入更多文本（作为单元格值的组合，但不在表格内）时，它会破坏表格格式并插入表格上方。

我在 Mac 上运行 Office 16.78.3。

这是我所拥有的：

Sub GenerateWordDoc()
    Dim ws As Worksheet
    Dim wdApp As Object
    Dim wdDoc As Object
    Dim objSelection As Object
    Dim lastRow As Long
    Dim lenderName As String
    Dim i As Long
    Dim addressFound As Boolean
    Dim subtotal As Double
    Dim selectedLender As String
    Dim lenderAddress As String
    
    ' Set worksheet
    Set ws = ThisWorkbook.Sheets("Sheet1")
    
    ' Get last row of data
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    
    ' Prompt user to select lender
    selectedLender = Application.InputBox("Select Name", "Name Selection", Type:=2)
    
    Set wdApp = GetObject(, "Word.Application")
    On Error GoTo 0

    ' If Word is not running, create a new instance
    If wdApp Is Nothing Then
        Set wdApp = CreateObject("Word.Application")
    End If    
    Set wdDoc = wdApp.Documents.Add
    Set objSelection = wdApp.Selection
   
   ' Make Word visible
    wdApp.Visible = True
    wdApp.Activate

    ' Write  Name to Word document
    objSelection.TypeText selectedLender & vbCrLf
   
    ' Summarize entries for the selected Lender
    objSelection.TypeText "Summary of Loans:" & vbCrLf & vbCrLf
    wdDoc.Tables.Add wdDoc.Content, 1, 3
    wdDoc.Tables(1).Cell(1, 1).Range.Text = "DATE"
    wdDoc.Tables(1).Cell(1, 2).Range.Text = "AMOUNT"
    wdDoc.Tables(1).Cell(1, 3).Range.Text = "TYPE"

    Dim rowCount As Integer
    rowCount = 2

    ' For i = 2 To lastRow
    For i = 2 To 18
        If ws.Cells(i, 5).Value = selectedLender Then
            wdDoc.Tables(1).Rows.Add
            wdDoc.Tables(1).Cell(rowCount, 1).Range.Text = ws.Cells(i, 1).Value
            wdDoc.Tables(1).Cell(rowCount, 2).Range.Text = ws.Cells(i, 8).Value
            wdDoc.Tables(1).Cell(rowCount, 3).Range.Text = ws.Cells(i, 7).Value
            subtotal = subtotal + ws.Cells(i, 8).Value
            rowCount = rowCount + 1
        End If
    Next i
    
    ' Add subtotal
    wdDoc.Content.Text = "Subtotal: " & subtotal
    
    Set wdDoc = Nothing
    Set wdApp = Nothing
    
End Sub

Answer 1

问题出在这一行：

wdDoc.Tables.Add wdDoc.Content, 1, 3

wdDoc.Content

是代表文档整个正文的范围。向此范围添加表格会替换内容。请参阅https://learn.microsoft.com/en-us/office/vba/api/word.tables.add

我假设您希望表格出现在文档的末尾，请使用以下内容：

wdDoc.Tables.Add wdDoc.Characters.Last, 1, 3