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 objects 而不是 Selection。您可以将 Range 想象成一个不可见的选择，但有一个非常重要的区别：可以有多个 Ranges；只能选择一个。

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

如果查找成功，找到的范围将复制到分节符的范围。 Duplicate 使原始范围成为独立的 "copy"，以便它们可以相互独立地进行操作。然后分节符的范围折叠到它的起点（把它想象成按 left-arrow），然后插入分节符。

但是，“查找”范围折叠到其终点，以便将其移到标题 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

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

Word 2016 VBA 循环直到文档结束

Word 2016 VBA loop until end of document

vba

ms-word

word-2016