Vba 将多个表从excel导出到word时覆盖的表

我试图使用VBA创建一个Word文档，在一个新页面上有多个表（使用循环），每个表都使用Excel中的单元格信息编译

到目前为止，除了插入第一个表之后，所有的工作都非常出色，它被第二个表替换，然后第三个表替换第二个表，依此类推。我只剩下最后创建的表

我不知道如何创建新表，而不是替换以前创建的表

Excel表格的屏幕截图

---

你只摆了一张桌子

 '(5e)Create Word table
    Set wdRange = wdDoc.Range
        wdDoc.Tables.Add wdRange, NumRows:=(TotRows), NumColumns:=5, DefaultTableBehavior:=wdWord8TableBehavior, AutoFitBehavior:=wdAutoFitWindow

    Set wdTabl = wdDoc.Tables(1)

更改代码

'(5e)Create Word table
Set wdRange = wdDoc.Range
Set wdTabl = wdDoc.Tables.Add(wdRange, NumRows:=(TotRows), NumColumns:=5, DefaultTableBehavior:=wdWord8TableBehavior, AutoFitBehavior:=wdAutoFitWindow)

'Set wdTabl = wdDoc.Tables(1)

---

你只摆了一张桌子

 '(5e)Create Word table
    Set wdRange = wdDoc.Range
        wdDoc.Tables.Add wdRange, NumRows:=(TotRows), NumColumns:=5, DefaultTableBehavior:=wdWord8TableBehavior, AutoFitBehavior:=wdAutoFitWindow

    Set wdTabl = wdDoc.Tables(1)

更改代码

'(5e)Create Word table
Set wdRange = wdDoc.Range
Set wdTabl = wdDoc.Tables.Add(wdRange, NumRows:=(TotRows), NumColumns:=5, DefaultTableBehavior:=wdWord8TableBehavior, AutoFitBehavior:=wdAutoFitWindow)

'Set wdTabl = wdDoc.Tables(1)

---

这个精简版对我很有用：

Sub Export_to_Word()

    Dim wdApp As Word.Application, i As Long, wdDoc As Word.Document
    Dim wdCell As Word.Cell, wdTabl As Word.Table, wdRange As Word.Range
    Dim wbBook As Workbook, wsSheet As Worksheet

    Set wbBook = ThisWorkbook
    Set wsSheet = wbBook.Worksheets("Sheet1")

    Set wdApp = New Word.Application
    wdApp.Visible = True
    Set wdDoc = wdApp.Documents.Add

    For i = 1 To 5
        wdDoc.Paragraphs.Add
        Set wdRange = ActiveDocument.Paragraphs.Last.Range

        Set wdTabl = wdDoc.Tables.Add(wdRange, NumRows:=5, NumColumns:=5, _
            DefaultTableBehavior:=wdWord8TableBehavior, _
            AutoFitBehavior:=wdAutoFitWindow)

        With wdTabl
            .Borders.Enable = True
            .Columns(1).Cells(1).Range.Text = "First"
            .Columns(5).Cells(5).Range.Text = "Last"
        End With
    Next i

End Sub

---

这个精简版对我很有用：

Sub Export_to_Word()

    Dim wdApp As Word.Application, i As Long, wdDoc As Word.Document
    Dim wdCell As Word.Cell, wdTabl As Word.Table, wdRange As Word.Range
    Dim wbBook As Workbook, wsSheet As Worksheet

    Set wbBook = ThisWorkbook
    Set wsSheet = wbBook.Worksheets("Sheet1")

    Set wdApp = New Word.Application
    wdApp.Visible = True
    Set wdDoc = wdApp.Documents.Add

    For i = 1 To 5
        wdDoc.Paragraphs.Add
        Set wdRange = ActiveDocument.Paragraphs.Last.Range

        Set wdTabl = wdDoc.Tables.Add(wdRange, NumRows:=5, NumColumns:=5, _
            DefaultTableBehavior:=wdWord8TableBehavior, _
            AutoFitBehavior:=wdAutoFitWindow)

        With wdTabl
            .Borders.Enable = True
            .Columns(1).Cells(1).Range.Text = "First"
            .Columns(5).Cells(5).Range.Text = "Last"
        End With
    Next i

End Sub

---

Tables.Add

中第一个参数的说明是“希望表格显示的范围。如果范围未折叠，则表格将替换该范围”。您需要将该范围折叠到现有内容的末尾（然后可能添加新段落）在添加下一个表之前。是的，我考虑了折叠问题，并在内容末尾包含了一个

。折叠方向：=wdCollapseEnd

函数。我认为它工作不正常，我花了几个小时调整了内容和位置，但没有效果。

Tables.Add

中第一个参数的描述是“希望表格显示的范围。如果范围未折叠，表格将替换该范围。”在添加下一个表之前，您需要将范围折叠到现有内容的末尾（然后可能添加新段落）。是的，我考虑了折叠问题，并在内容的末尾包含了一个

。折叠方向：=wdCollapseEnd

函数。我认为它工作不正常，我花了几个小时调整内容和位置，但没有用。这是一个很好的建议。我做了您建议的更改，以便创建一个新表。然而，同样的问题仍然在发生，这是一个很好的建议。我做了您建议的更改，以便创建一个新表。但是，同样的问题仍然在发生。谢谢！我对VBA（以及一般的编码）相当陌生，但您提醒我将代码简化为最基本的需求这一重要的问题解决方法。本质上，问题在于我选择了文档的整个范围，并用循环中的下一个表替换了旧表。更改为

wdRange=ActiveDocument.parages.Last.Range

成功解决了我的问题。谢谢！我对VBA（以及一般的编码）相当陌生，但您提醒我将代码简化为最基本的需求这一重要的问题解决方法。本质上，问题在于我选择了文档的整个范围，并用循环中的下一个表替换了旧表。更改为

wdRange=ActiveDocument.parages.Last.Range

成功解决了我的问题。