Word 2016 VBA 循环直到文档结束

Question

我在网上查看了许多不同的答案，但未能找到适合我的代码的解决方案。这是我第一次在 Word 中编写 VBA（对 Excel 有一定的经验）。

我认为this post 可能是我需要的，但它并没有为我停止文档末尾的循环。

我正在尝试在新部分的开始之前插入一个连续的分节符，我将其指定为格式为标题 1 的文本。我完全愿意以另一种方式这样做，并感谢您见解！

Sub InsertSectionBreak()
    ' Go to start of document
    Selection.HomeKey Unit:=wdStory

    ' Find next section based on header formatting, insert continuous section break just before
    '
    Selection.Find.ClearFormatting
    Selection.Find.Style = ActiveDocument.Styles("Heading 1")
    With Selection.Find
        .Text = ""
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindStop
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With

    Do While Selection.Find.Execute = True
        Selection.Find.Execute
        Selection.MoveLeft Unit:=wdCharacter, Count:=1
        Selection.InsertBreak Type:=wdSectionBreakContinuous
    Loop
End Sub

Answer 1

问题中的代码还不错，但有一个主要问题：Selection 被移到文档的前面，以便插入分节符。这意味着下次Find 再次运行时会找到相同的标题 1，因此会在相同的位置重复插入分节符。

另一个问题是代码正在执行 Find 作为 Do While 标准的一部分（这就是为什么它没有在文档中找到标题 1 的第一个实例）。

以下代码示例使用Range 对象而不是Selection。您可以将 Range 视为一个不可见的选择，但有一个非常重要的区别：可以有多个 Range；只能选择一个。

建议的代码使用两个范围：一个用于查找，另一个用于插入分节符。查找范围设置为整个文档。 Find 是否成功存储在一个布尔变量 (bFound) 中。

如果查找成功，则将找到的范围复制到分节符的范围。 Duplicate 制作原始范围的独立“副本”，以便可以彼此独立地操作它们。然后将分节符的范围折叠到其起点（将其想象为按左箭头），然后插入分节符。

然而，查找范围被折叠到它的结束点，以便将其移动到使用标题 1 格式化的文本之外，以便可以定位下一个标题 1。然后再次执行 Find 并重复循环，直到找不到更多的 Heading 1 实例。

Sub InsertSectionBreak()
    Dim rngFind As Word.Range, rngSection As Word.Range
    Dim bFound As Boolean

    Set rngFind = ActiveDocument.content

    ' Find next section based on header formatting, insert continuous section break just before
    '
    rngFind.Find.ClearFormatting
    rngFind.Find.style = ActiveDocument.styles("Heading 1")
    With rngFind.Find
        .text = ""
        .Replacement.text = ""
        .Forward = True
        .wrap = wdFindStop
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
        bFound = .Execute
    End With

    Do While bFound
        Set rngSection = rngFind.Duplicate
        rngSection.Collapse wdCollapseStart
        rngSection.InsertBreak Type:=wdSectionBreakContinuous
        rngFind.Collapse wdCollapseEnd
        bFound = rngFind.Find.Execute
    Loop
End Sub

Answer 2

如果您感兴趣的内容与某个标题相关，则无需分节符即可获取该标题下的所有内容。例如：

Sub GetHeadingSpanText()
Application.ScreenUpdating = False
Dim Rng As Range
With ActiveDocument.Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = InputBox("What is the text to find?")
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindStop
    .Format = True
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
    .Execute
  End With
  If .Find.Found = True Then
    Set Rng = .Paragraphs(1).Range
    Set Rng = Rng.GoTo(What:=wdGoToBookmark, Name:="\HeadingLevel")
    MsgBox Rng.Text
  End If
End With
Set Rng = Nothing
Application.ScreenUpdating = True
End Sub

请注意，此方法获取与最近标题相关的所有内容，无论其级别如何；可以使用更复杂的方法来获取与特定标题级别关联的所有内容，这样，如果在子标题下找到匹配项，则使用先前的主标题来确定跨越的范围。