VBA生成含多表格Word文档时如何在标题后插入对应表格目录

实现方案 #

要实现180个表格对应生成目录，核心是给每个表格增加可被Word目录识别的样式标题，再插入自动目录即可，以下是修改后的完整代码，新增部分已加注释说明：

Sub CreateBasicWordRepot()
    Dim wdApp As Word.Application
    Dim myDoc As Word.Document
    Dim tbl As Excel.Range
    Dim I As Integer
    Dim t As Word.Table
    Dim wsSource As Worksheet, wsTemplate As Worksheet
    
    ' 提前绑定工作表，避免反复Select提升运行速度
    Set wsSource = ThisWorkbook.Worksheets("Sept 2021 tests")
    Set wsTemplate = ThisWorkbook.Worksheets("sheet1")
    
    Set wdApp = New Word.Application
    With wdApp
        .Visible = True
        .Activate
        Set myDoc = .Documents.Add ' 绑定生成的文档对象，后续不用依赖Selection
        
        ' 写入主标题
        With .Selection
            .ParagraphFormat.Alignment = wdAlignParagraphLeft
            .BoldRun
            .Font.Size = 14
            .TypeText "<<Company Name>> IM Validation <<year>> testing template"
            .BoldRun
            .TypeParagraph
            .Font.Size = 11
            .TypeParagraph
        End With
        
        ' ========== 新增：预留目录位置，先插临时分页，表格生成后返回此处插入目录 ==========
        .Selection.InsertBreak Type:=wdPageBreak
        Dim dirRange As Word.Range
        Set dirRange = myDoc.Range(myDoc.Content.Start, .Selection.Range.Start) ' 标记目录插入区间
        
        ' 循环生成每个表格
        For I = 4 To 186
            ' 替换原有的Select操作，直接赋值效率更高
            wsTemplate.Range("B14").Value = wsSource.Range("B" & I).Value
            wsTemplate.Range("B3").Value = wsSource.Range("C" & I).Value
            wsTemplate.Range("B5").Value = wsSource.Range("D" & I).Value
            wsTemplate.Range("B18").Value = wsSource.Range("E" & I).Value
            
            ' ========== 新增：每个表格前加可被目录识别的标题，可用其他列内容替换C列 ==========
            With .Selection
                .Style = wdStyleHeading2 ' 应用二级标题样式，目录会自动提取该样式内容
                .TypeText wsSource.Range("C" & I).Value ' 可修改为你想要显示在目录里的文本
                .TypeParagraph
            End With
            
            ' 复制粘贴模板表格
            Set tbl = wsTemplate.Range("A1:B27")
            tbl.Copy
            .Selection.PasteExcelTable LinkedToExcel:=False, WordFormatting:=False, RTF:=False
            .Selection.InsertBreak Type:=wdPageBreak
        Next I
        
        ' ========== 新增：插入并更新目录 ==========
        myDoc.TablesOfContents.Add _
            Range:=dirRange, _
            UseHeadingStyles:=True, _
            LowerHeadingLevel:=2, _
            UpperHeadingLevel:=2 ' 仅提取二级标题作为目录条目
        myDoc.TablesOfContents(1).Update ' 自动更新目录页码
        
        ' 统一调整表格宽度
        For Each t In myDoc.Tables
            t.AutoFitBehavior wdAutoFitWindow
        Next t
    End With
End Sub

补充说明 #

• 如果需要修改目录显示的条目内容，只需要修改.TypeText wsSource.Range("C" & I).Value这一行，换成你想要展示的字段即可
• 如果需要调整目录的层级、样式，可以修改TablesOfContents.Add的相关参数
• 原有代码中的大量Select操作已替换为直接赋值，运行速度会有明显提升

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