使用VBA在Word中添加目录出现多余标题问题

问题原因 #

你遇到的问题是因为**"Alt Heading 1"和"App H1 Title"这两个样式被设置了目录级别（TOC Level）**，或是被添加到了Word默认的"用于目录的样式"列表中。即使代码中指定了AddedStyles并设置UseHeadingStyles:=False，Word仍会包含这些已配置目录级别的样式。

解决方案 #

方案一：重置全局样式目录级别 #

先清除所有段落样式的目录级别设置，再手动为需要的样式指定级别，确保只有目标样式被包含进目录：

Dim TOC As TableOfContents
Dim sty As Style

' 清除所有段落样式的目录级别（设为0表示不包含在目录中）
For Each sty In ActiveDocument.Styles
    If sty.Type = wdStyleTypeParagraph Then
        sty.TOCLevel = 0
    End If
Next sty

' 为需要的样式设置对应的目录级别
With ActiveDocument
    .Styles("Heading 1").TOCLevel = 1
    .Styles("Heading 2").TOCLevel = 2
    .Styles("Heading 3").TOCLevel = 3
End With

' 删除现有目录（如果存在）
If ActiveDocument.TablesOfContents.Count > 0 Then
    ActiveDocument.TablesOfContents(1).Delete
End If

' 添加新目录
Set TOC = ActiveDocument.TablesOfContents.Add( _
    Range:=Selection.Range, _
    RightAlignPageNumbers:=True, _
    UseHeadingStyles:=True, ' 此时只会包含我们设置了TOCLevel的样式
    IncludePageNumbers:=True, _
    UseHyperlinks:=True, _
    HidePageNumbersInWeb:=True, _
    UseOutlineLevels:=False _
)

方案二：直接移除目录中的额外样式条目 #

如果不想修改文档样式的全局设置，可在生成目录后直接移除不需要的样式条目：

Dim TOC As TableOfContents
Dim includedStyles As String

includedStyles = "Heading 1;1;Heading 2;2;Heading 3;3"

' 删除现有目录（如果存在）
If ActiveDocument.TablesOfContents.Count > 0 Then
    ActiveDocument.TablesOfContents(1).Delete
End If

' 添加新目录
Set TOC = ActiveDocument.TablesOfContents.Add( _
    Range:=Selection.Range, _
    RightAlignPageNumbers:=True, _
    UseHeadingStyles:=False, _
    IncludePageNumbers:=True, _
    AddedStyles:=includedStyles, _
    UseHyperlinks:=True, _
    HidePageNumbersInWeb:=True, _
    UseOutlineLevels:=False _
)

' 移除不需要的样式条目
On Error Resume Next ' 防止样式不存在时触发报错
TOC.TableOfContentsStyles("Alt Heading 1").Delete
TOC.TableOfContentsStyles("App H1 Title").Delete
On Error GoTo 0

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