每个标题 2 下的 Table 内容 (TOC) 仅显示其副标题

Question

我在超过 1000 页的 Word 文档中使用了 90 次标题 2。每个标题二都有许多副标题。最终目标是在每个标题 2 下添加一个单独的 Table Of Content (TOC)，它仅显示该特定标题 2 下的子标题（排除标题 2 本身的文本，这本身可以通过限制TOC 至标题 3 及更小）。在网上搜索清楚，这并不像听起来那么简单。例如，TOC 选项中没有用于将 TOC 限制为下一个分节符的复选框，因此使用分节符来实现这一点毫无意义。唯一的方法似乎是为每个标题 2 下的所有文本添加单独的书签，并将目录代码限制为目录所在的相关书签。

我想不出一种方法来为每个标题 2 下的每个文本 selections 自动创建唯一命名的书签（例如在我的例子中是数字 1 到 90）。所以我愿意手动执行此操作。但如果不手动 select 每个标题 2.

下的所有文本，这已经是一种帮助

所以问题来了：哪个 VBA 代码可以帮助我解决这个 selection？或者您能想出一个在实现最终目标方面走得更远的代码吗？

最远的是找到一个标题2，在它前面加上两个不寻常的符号“£$”，转到下一个标题2做同样的事情等等。这里的想法是，一旦完成，我只需要在 $*£ 上使用通配符搜索 select 从标题 2 到下一个标题的文本。

但是我的代码一直在循环（当到达文档末尾时它从顶部重新开始），从今天开始它似乎不再工作了。而且，不可否认，也许整个方法有点蹩脚。尽管如此，我还是把代码贴在了底部。

非常感谢您的帮助，无论是通过改进我的代码，还是通过共享文档中下一个标题 2 下 selects 文本的其他代码（一个宏，然后我可以手动重复以继续在文档中创建手动书签）或找到更好的方法来实现每个标题 2 下单独目录的最终目标，仅显示该特定标题下的标题。

非常感谢。

威廉

Do While Selection.Find.Found = True
    
Selection.HomeKey Unit:=wdStory
        
Selection.Find.ClearFormatting
Selection.Find.Style = ActiveDocument.Styles("Kop 2")
With Selection.Find
    .Text = ""
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindContinue
    .Format = True
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
End With
    Selection.Find.Execute

If Selection.Find.Found Then
    Selection.MoveLeft Unit:=wdCharacter, Count:=1

    Selection.TypeText Text:="$£"
    Selection.MoveDown Unit:=wdLine, Count:=4
End If

Loop

Answer 1

例如：

Sub AddHeading2TOCs()
Application.ScreenUpdating = False
Dim RngHd As Range, h As Long
With ActiveDocument.Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = ""
    .Replacement.Text = ""
    .Style = wdStyleHeading2
    .Format = True
    .Forward = True
    .Wrap = wdFindStop
  End With
  Do While .Find.Execute
    Set RngHd = .Paragraphs(1).Range: h = h + 1
    RngHd.InsertAfter vbCr
    Set RngHd = RngHd.GoTo(What:=wdGoToBookmark, Name:="\HeadingLevel")
    With RngHd
      .Paragraphs(2).Range.Style = wdStyleNormal
      .Start = .Paragraphs(2).Range.End
      .Bookmarks.Add "BkMkHd" & h, .Duplicate
      .Start = .Start - 1
      .Collapse wdCollapseStart
      .Fields.Add .Duplicate, wdFieldEmpty, "TOC \b BkMkHd" & h, False
    End With
    .Collapse wdCollapseEnd
  Loop
End With
Set RngHd = Nothing
Application.ScreenUpdating = True
End Sub

每个标题 2 下的 Table 内容 (TOC) 仅显示其副标题

A Table of Content (TOC) under each heading 2 showing only the subheadings thereof

vba

ms-word

tableofcontents

heading