VBA实现Word跨页表格拆分

VBA代码功能

1. 完成跨页表格的拆分并自动重复表头。
2. 注：表格的题注需要手动添加！

VBA代码实现

1. 选中需要拆分的表格
   
2. 运行功能“宏”
   
3. 实现效果
   

VBA代码

Sub SplitTableAtPageBreaks()
    Dim doc As Document
    Dim tbl As Table
    Dim row As row
    Dim rowIndex As Long
    Dim startPage As Long
    Dim endPage As Long
    Dim rowStartRange As Range
    Dim rowEndRange As Range
    Dim firstRow As Range

    ' 获取当前活动文档
    Set doc = ActiveDocument

    ' 检查是否有选中的表格
    If Selection.Information(wdWithInTable) Then
        Set tbl = Selection.Tables(1)
        
        ' 获取表格的第一行
        Set firstRow = tbl.Rows(1).Range.Duplicate
        
            
        ' 获取第一行所在的页面
        firstRowPage = tbl.Rows(1).Range.Information(wdActiveEndPageNumber)
        Found = False
        
        ' 遍历表格中的每一行，从第二行开始
        For rowIndex = 2 To tbl.Rows.Count
            Set row = tbl.Rows(rowIndex)
            
            ' 获取当前行所在的页面
            rowPage = row.Range.Information(wdActiveEndPageNumber)
            
            ' 检查是否与第一行所在页不同
            If rowPage <> firstRowPage Then
                ' 拆分表格
                ' tbl.Split (rowIndex)

                ' 插入一个新的表格，复制第一行内容到新表格
                Dim newTbl As Table
                Set newTbl = tbl.Split(rowIndex)
                
                ' 插入一个新行作为新表格的第一行
                newTbl.Rows.Add newTbl.Rows(1)
                
                ' 复制原表格的第一行到新表格的第一行
                newTbl.Rows(1).Range.FormattedText = firstRow.FormattedText
                
                ' 删除新表格插入的空白行
                newTbl.Rows(2).Delete
                
                Exit For
            End If
        Next rowIndex
    Else
        MsgBox "请先选择一个表格。"
    End If
    
    Set lastRow = tbl.Rows(tbl.Rows.Count)
    
    ' 设置最后一行底部边框为1.5pt的实线
    With lastRow.Borders(wdBorderBottom)
        .LineStyle = wdLineStyleSingle
        .LineWidth = wdLineWidth150pt
        .Color = wdColorAutomatic
    End With
    
End Sub