Excel宏操作Word插入分页符报错及单文档多表格生成问题

我希望通过Excel宏在单个Word文档中生成三个表格，目前遇到以下问题：

• 最初的代码可生成格式正确的大表格，但无法在指定位置插入分页符。执行If r = First Then wdDoc.InsertBreak时触发运行时错误'438'（对象不支持该属性或方法）。
• 后续实现了在三个独立Word文档中生成带分页符的三个表格，但想合并到单个文档中。移除第二、第三次循环中的Set wdDoc = .Documents.Add语句后，仅会生成第三个表格，疑似之前的表格被覆盖。

初始尝试代码 #

Dim wdApp As New Word.Application
Dim wdDoc As Word.Document
Dim wdTbl As Word.Table
Dim xlSht As Worksheet
Dim lRow As Integer
Dim lCol As Integer
Dim r As Integer
Dim c As Integer
Dim Blanks As Integer
Dim First As Integer
Dim Second As Integer

lRow = Sheets("Feedback Sheets").Range("A1000").End(xlUp).Row - 2

Blanks = 0
i = 1
    Do While i <= lRow
    Set rRng = Worksheets("Feedback Sheets").Range("A" & i)

        If IsEmpty(rRng.Value) Then
        
            Blanks = Blanks + 1
            
                If Blanks = 1 Then First = i
                If Blanks = 2 Then Second = i
                
        End If
        
        i = i + 1
    Loop
'Now I know where end of each table is

Set xlSht = ActiveSheet: lCol = 5
With wdApp
  .Visible = True
  Set wdDoc = .Documents.Add
  With wdDoc
    Set wdTbl = .Tables.Add(Range:=.Range, NumRows:=2, NumColumns:=lCol)
    With wdTbl
      .Rows(1).Range.Font.Bold = True
      .Rows(1).HeadingFormat = True
      .Cell(1, 1).Range.Text = "Header 1"
      If lCol > 1 Then .Cell(1, 2).Range.Text = "Header 2"
      If lCol > 2 Then .Cell(1, 3).Range.Text = "Header 3"
    End With
    With xlSht
      For r = 1 To lRow
        If (r + 1) > wdTbl.Rows.Count Then wdTbl.Rows.Add
        If r = First Then wdDoc.InsertBreak

        If r = Second Then wdDoc.InsertBreak

        For c = 1 To lCol
          wdTbl.Cell(r + 1, c).Range.Text = xlSht.Cells(r, c).Text
        Next c
      Next r
    End With
  End With
End With

Set myTable = ActiveDocument.Tables(1)
With myTable.Borders
 .InsideLineStyle = wdLineStyleSingle
 .OutsideLineStyle = wdLineStyleDouble
End With

Set wdTbl = Nothing: Set wdDoc = Nothing: Set wdApp = Nothing: Set xlSht = Nothing

多文档实现代码 #

Dim wdApp As New Word.Application
Dim wdDoc As Word.Document
Dim wdTbl1 As Word.Table
Dim wdTbl2 As Word.Table
Dim wdTbl3 As Word.Table
Dim xlSht As Worksheet
Dim lRow As Integer
Dim lCol As Integer
Dim r As Integer
Dim c As Integer
Dim Blanks As Integer
Dim First As Integer
Dim Second As Integer

lRow = Sheets("Feedback Sheets").Range("A1000").End(xlUp).Row - 2

Blanks = 0
i = 1
    Do While i <= lRow
    Set rRng = Worksheets("Feedback Sheets").Range("A" & i)

        If IsEmpty(rRng.Value) Then
        
            Blanks = Blanks + 1
            
                If Blanks = 1 Then First = i
                If Blanks = 2 Then Second = i
                
        End If
        
        i = i + 1
    Loop
'Now I know where end of each table is

Set xlSht = ActiveSheet: lCol = 5
With wdApp
  .Visible = True
  Set wdDoc = .Documents.Add
  With wdDoc
    Set wdTbl1 = .Tables.Add(Range:=.Range, NumRows:=2, NumColumns:=lCol)
    With wdTbl1
      .Rows(1).Range.Font.Bold = True
      .Rows(1).HeadingFormat = True
      .Cell(1, 1).Range.Text = "Header 1"
      If lCol > 1 Then .Cell(1, 2).Range.Text = "Header 2"
      If lCol > 2 Then .Cell(1, 3).Range.Text = "Header 3"
    End With
    With xlSht
      For r = 1 To First
        If (r + 1) > wdTbl1.Rows.Count Then wdTbl1.Rows.Add
        If r = First Then wdDoc.Characters.Last.InsertBreak Type:=wdPageBreak
        For c = 1 To lCol
          wdTbl1.Cell(r + 1, c).Range.Text = xlSht.Cells(r, c).Text
        Next c

      Next r
    End With
  End With
End With

Set myTable = ActiveDocument.Tables(1)
With myTable.Borders
 .InsideLineStyle = wdLineStyleSingle
 .OutsideLineStyle = wdLineStyleDouble
End With

With wdApp
 .Visible = True
  Set wdDoc = .Documents.Add
  With wdDoc
    Set wdTbl2 = .Tables.Add(Range:=.Range, NumRows:=2, NumColumns:=lCol)
    With wdTbl2
      .Rows(1).Range.Font.Bold = True
      .Rows(1).HeadingFormat = True
      .Cell(1, 1).Range.Text = "Header 1"
      If lCol > 1 Then .Cell(1, 2).Range.Text = "Header 2"
      If lCol > 2 Then .Cell(1, 3).Range.Text = "Header 3"
    End With
    With xlSht
      For r = First To Second
        If (r + 1) > wdTbl2.Rows.Count Then wdTbl2.Rows.Add

        If r = Second Then wdDoc.Characters.Last.InsertBreak Type:=wdPageBreak

        For c = 1 To lCol
          wdTbl2.Cell(r + 1, c).Range.Text = xlSht.Cells(r, c).Text
        Next c
      Next r
    End With
  End With
End With

Set myTable = ActiveDocument.Tables(1)
With myTable.Borders
 .InsideLineStyle = wdLineStyleSingle
 .OutsideLineStyle = wdLineStyleDouble
End With

With wdApp
 .Visible = True
  Set wdDoc = .Documents.Add
  With wdDoc
    Set wdTbl3 = .Tables.Add(Range:=.Range, NumRows:=2, NumColumns:=lCol)
    With wdTbl3
      .Rows(1).Range.Font.Bold = True
      .Rows(1).HeadingFormat = True
      .Cell(1, 1).Range.Text = "Header 1"
      If lCol > 1 Then .Cell(1, 2).Range.Text = "Header 2"
      If lCol > 2 Then .Cell(1, 3).Range.Text = "Header 3"
    End With
    With xlSht
      For r = Second To lRow
        If (r + 1) > wdTbl3.Rows.Count Then wdTbl3.Rows.Add

        If r = Second Then wdDoc.Characters.Last.InsertBreak Type:=wdPageBreak

        For c = 1 To lCol
          wdTbl3.Cell(r + 1, c).Range.Text = xlSht.Cells(r, c).Text
        Next c
      Next r
    End With
  End With
End With

Set myTable = ActiveDocument.Tables(1)
With myTable.Borders
 .InsideLineStyle = wdLineStyleSingle
 .OutsideLineStyle = wdLineStyleDouble
End With

Set wdTbl1 = Nothing: Set wdTbl2 = Nothing: Set wdTbl3 = Nothing: Set wdDoc = Nothing: Set wdApp = Nothing: Set xlSht = Nothing

编辑2：该问题已偏离初始方向，我将标记此问题已解决并提出新问题。

内容的提问来源于stack exchange，提问作者d wattam