求助：如何为Word中跨页的Excel表格添加重复表头（附VBA代码）

要实现Word中表格跨页重复表头，只需在粘贴Excel表格后，为Word表格的表头行开启跨页重复属性。以下是具体修改方案：

修改逻辑 #

原代码仅完成了Excel表格到Word的粘贴，未配置Word表格的表头重复功能。我们需要在粘贴后：

1. 获取刚插入的Word表格对象
2. 选中表格的表头行（此处为第一行）
3. 设置该行的HeadingFormat = True，即可实现跨页重复显示

关键修改代码段 #

替换原代码中粘贴表格的部分，新增表头重复配置：

' Paste the Excel table in the Word document after the existing content
wordApp.Selection.Collapse Direction:=wdCollapseEnd ' Move the cursor to the end of the document
wordApp.Selection.PasteExcelTable LinkedToExcel:=False, WordFormatting:=False, RTF:=False

' ------------------- 新增：设置跨页重复表头 -------------------
Dim wordTable As Word.Table
' 获取刚粘贴的表格（文档中最后一个表格）
Set wordTable = wordDoc.Tables(wordDoc.Tables.Count)
' 设置表格第一行为跨页重复表头
wordTable.Rows(1).HeadingFormat = True
' -----------------------------------------------------------

完整修改后的代码 #

Sub GenerateWordFiles()

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.DisplayAlerts = False

    Set wsSummary = ThisWorkbook.Sheets("Summary")
    Set wsFormat = ThisWorkbook.Sheets("Format")
    lrow = wsSummary.Range("D" & Rows.Count).End(xlUp).Row

    Set wbNew = Workbooks.Add
    Set wsDestination = wbNew.Sheets(1)

    ' Set the source and destination worksheets
    Set wsSource = wsSummary

    ' Check if a filter is applied in the source sheet
    If Not wsSource.AutoFilterMode Then
        wsSource.Range("B5").AutoFilter
    Else
        wsSource.AutoFilterMode = False
    End If

    lrowSource = lrow

    ' Define the filter range and filter value
    Set filterRange = wsSource.Range("B5:U" & lrowSource)
    filterValue = ">0"

    ' Apply the filter to the filter range
    filterRange.AutoFilter Field:=11, Criteria1:=filterValue

    ' Copy the filtered data (excluding headers) to the destination sheet
    Set copyRange = wsSource.Range("D5:D" & lrowSource).SpecialCells(xlCellTypeVisible)
    copyRange.Copy wsDestination.Range("A1")

    Set copyRange = wsSource.Range("Q5:Q" & lrowSource).SpecialCells(xlCellTypeVisible)
    copyRange.Copy wsDestination.Range("B1")

    Set copyRange = wsSource.Range("L5:L" & lrowSource).SpecialCells(xlCellTypeVisible)
    copyRange.Copy wsDestination.Range("C1")

    Set copyRange = wsSource.Range("N5:N" & lrowSource).SpecialCells(xlCellTypeVisible)
    copyRange.Copy wsDestination.Range("D1")

    Set copyRange = wsSource.Range("O5:O" & lrowSource).SpecialCells(xlCellTypeVisible)
    copyRange.Copy wsDestination.Range("E1")

    Set copyRange = wsSource.Range("P5:P" & lrowSource).SpecialCells(xlCellTypeVisible)
    copyRange.Copy wsDestination.Range("F1")

    wsDestination.Range("A1").Value = "Name of the Investment"
    wsDestination.Range("B1").Value = "Listed-Unlisted"
    wsDestination.Range("C1").Value = "Cost Value"
    wsDestination.Range("D1").Value = "Fair Value"
    wsDestination.Range("E1").Value = "Valuation Methodology"
    wsDestination.Range("F1").Value = "Sector"

'    With wsDestination.Range("A1:F1").Interior
'        .Pattern = xlSolid
'        .PatternColorIndex = xlAutomatic
'        .ThemeColor = xlThemeColorDark1
'        .TintAndShade = -0.499984740745262
'        .PatternTintAndShade = 0
'    End With
'
'    With wsDestination.Range("A1:F1").Font
'        .Bold = True
'        .Italic = False
'    End With

    lrowDestination = wsDestination.Range("A" & Rows.Count).End(xlUp).Row

    wsFormat.Columns("A:F").Copy

    wsDestination.Columns("A:F").PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False

    ' Turn off the filter in the source sheet
    wsSource.AutoFilterMode = False


    Dim wordApp As Word.Application
    Dim wordDoc As Word.Document
    Dim excelApp As Excel.Application
    Dim excelWorkbook As Excel.Workbook
    Dim excelWorksheet As Excel.Worksheet

    ' Initialize Word and open a blank document
    Set wordApp = New Word.Application
    wordApp.Visible = True ' Set to False if you don't want the Word application to be visible

    ' Create a new blank document
    Set wordDoc = wordApp.Documents.Add
    
    
    ' Set the page margins
    With wordDoc.PageSetup
        .LeftMargin = wordApp.InchesToPoints(0.5) ' Set the left margin to 0.5 inches
        .RightMargin = wordApp.InchesToPoints(0.5) ' Set the right margin to 0.5 inches
        .TopMargin = wordApp.InchesToPoints(0.5) ' Set the top margin to 0.5 inches
        .BottomMargin = wordApp.InchesToPoints(0.5) ' Set the bottom margin to 0.5 inches
    End With
    
    Set wsUI = ThisWorkbook.Sheets("UI")

    Text1 = wsUI.Range("D3").Value
    Text2 = wsUI.Range("D4").Value
    Text3 = wsUI.Range("D5").Value

    ' Write the title in the middle of the document
    With wordDoc.Content
        .Paragraphs.Add
        .ParagraphFormat.Alignment = wdAlignParagraphCenter ' Center alignment
        .Font.Name = "Calibri"
        .Font.size = 22
        .Font.Bold = True
        .InsertAfter Text1
    End With

    ' Add three lines of free text
    With wordDoc.Content
        .Paragraphs.Add
        .InsertAfter Text2
        .ParagraphFormat.Alignment = wdAlignParagraphLeft ' Left alignment
        .Font.Name = "Calibri (Body)"
        .Font.size = 12
        .Font.Bold = True
        .Collapse Direction:=wdCollapseEnd ' Move the cursor to the end of the text
        .InsertParagraphAfter ' Add a new paragraph
        .InsertAfter Text3
        .ParagraphFormat.Alignment = wdAlignParagraphLeft ' Left alignment
        .Font.Name = "Calibri (Body)"
        .Font.size = 12
        .Font.Bold = False
    End With

    ' Format the first line
    With wordDoc.Content.Paragraphs(2).Range
        .Font.size = 24 ' Example: Increase font size for the first line
        .Font.Bold = True ' Example: Apply bold formatting to the first line
        .ParagraphFormat.Alignment = wdAlignParagraphCenter ' Center alignment
        ' Apply other formatting as needed
    End With

    ' Set the worksheet to copy data from
    Set excelWorksheet = wbNew.Sheets(1) ' Replace with the actual worksheet name

    ' Move the cursor to the end of the document
    wordDoc.Content.End = wordDoc.Content.End - 1
    
    ' Copy the range from Excel
    excelWorksheet.Range("A1:F" & lrowDestination).Copy
    
    ' Move the cursor to the end of the document
    wordApp.Selection.EndKey Unit:=wdStory
    
    ' Paste the Excel table in the Word document after the existing content
    wordApp.Selection.Collapse Direction:=wdCollapseEnd ' Move the cursor to the end of the document
    wordApp.Selection.PasteExcelTable LinkedToExcel:=False, WordFormatting:=False, RTF:=False

    ' ------------------- 新增：设置跨页重复表头 -------------------
    Dim wordTable As Word.Table
    ' 获取刚粘贴的表格（文档中最后一个表格）
    Set wordTable = wordDoc.Tables(wordDoc.Tables.Count)
    ' 设置表格第一行为跨页重复表头
    wordTable.Rows(1).HeadingFormat = True
    ' -----------------------------------------------------------
    
    wbNew.Close False


    ' Get the folder path of the Excel file
    Dim excelFolderPath As String
    excelFolderPath = ThisWorkbook.path
    LocalFolderPath = GetLocalPath(excelFolderPath)
    
    ' Save the Word document with the specified name in the same folder
    Dim savePath As String
    savePath = LocalFolderPath & "\" & Text1 & ".docx"
    wordDoc.SaveAs2 savePath



    ' Clean up
    Set wbNew = Nothing
    Set wordDoc = Nothing
    Set wordApp = Nothing

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.DisplayAlerts = True


    MsgBox "Done!"

End Sub

注意事项 #

• 确保VBA编辑器已引用Word对象库：依次点击工具 > 引用，勾选Microsoft Word xx.x Object Library（xx.x对应你的Word版本）
• 若表格包含多行表头，可扩展代码为wordTable.Rows(1).HeadingFormat = True: wordTable.Rows(2).HeadingFormat = True，以此类推设置需要重复的行

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