如何将 Word VBA Range.Find 返回的范围扩大到段落末尾

Question

我有大量的单词文本，其中的行应该是 Heading3，但实际上是以 *** 开头的简单文本

例如

*** Day 1

第一天发生了一些事情......等等

*** Day 2

第二天发生了一些事情......等等

我正在尝试选择这些行，删除 3 星字，并将该行作为标题 3。

我也在避免（最佳实践？）在 vba 中使用选择对象，而是专注于 range.find 方法。我可以很容易地找到 *** 字，但是如何扩展到行尾？实际上 range.find 没有扩展方法。所以我求助于通配符的使用......但我没有成功。

目前我没有开始代码的格式化过程，因为我没有设法通过查找过程。

   Sub FindAndReplace3Stars()
    Dim myStoryRange As Range   
    For Each myStoryRange In ActiveDocument.StoryRanges
     With myStoryRange.Find
      .Text = "<\*\*\*>*^13"
      .Replacement.Text = "B"
      .MatchWildcards = True 
      .Wrap = wdFindContinue 
      .Execute Replace:=wdReplaceAll
      End With
     Next myStoryRange
    End Sub

Answer 1

理论上，可以找到一些东西，将段落样式指定为替换的一部分，并且它应该会影响整个段落。但是，当要应用的样式是“链接样式”时，这会出现问题：既可以用作段落样式，也可以用作字符样式的样式。不幸的是，所有内置标题样式都是这种情况。应用这样的样式不一定会改变段落中文本字符的格式 - 直接格式化可能会覆盖，这样，当段落使用该样式格式化时，文本可能会在视觉上看起来不同。

因此，一个简单的查找/替换是不够的，因为需要额外的步骤来强制正确格式化。

以下内容对我有用。

我认为应该删除星号，因此将替换文本设置为空字符串。在这种情况下，通配符不是必需的。

执行在Do...Loop 中，以便单独找到该术语的每个实例并进行替换。然后应用样式并选择范围，以便使用ClearCharacterDirectFormatting 方法。这相当于以用户身份按 Ctrl+空格键并强制选择显示段落样式的格式，该格式可能已被直接字体格式覆盖。

然后有必要在继续查找之前折叠Range。

   Sub FindAndReplace3Stars()
    Dim myStoryRange As Range
    Dim sFindTerm As String

    sFindTerm = "***"
    For Each myStoryRange In ActiveDocument.StoryRanges
       With myStoryRange.Find
        .Text = sFindTerm
        .Replacement.Text = ""
        .wrap = wdFindStop
        Do While .Execute(Replace:=wdReplaceOne)
          myStoryRange.style = wdStyleHeading3
          myStoryRange.Select
          With Selection
              .ClearCharacterDirectFormatting
          End With
          myStoryRange.Collapse wdCollapseEnd
        Loop
      End With
     Next myStoryRange
   End Sub

或者，基于问题中使用通配符并选择整个段落（不是句子）的原始方法，可能类似于以下代码示例。在这种情况下，搜索文本被分成两个“表达式”：星号和段落的其余部分。替换文本是第二个表达式（\@ - 段落的其余部分），在这种情况下，样式将作为替换的一部分应用。

仍然需要选择并清除直接格式，以确保样式格式可见。

   Sub FindAndReplace3Stars_Alternate()
    Dim myStoryRange As Range
    Dim sFindTerm As String

    sFindTerm = "(\*\*\*)(?*^013)"
    For Each myStoryRange In ActiveDocument.StoryRanges
     With myStoryRange.Find
        .Text = sFindTerm
        .Replacement.Text = "\2"
        .Replacement.style = wdStyleHeading3
        .MatchWildcards = True
        .wrap = wdFindStop
        Do While .Execute(Replace:=wdReplaceOne)
            myStoryRange.Select
            With Selection
                .ClearCharacterDirectFormatting
            End With
            myStoryRange.Collapse wdCollapseEnd
        Loop
      End With
     Next myStoryRange
    End Sub

Answer 2

大概您的文本仅在文档正文中，在这种情况下 - 除非有直接格式 - 您可以将代码简化为：

Sub FindAndReplace3Stars()
Application.ScreenUpdating = False
With ActiveDocument.Range.Find
  .ClearFormatting
  .Replacement.ClearFormatting
  .Text = "[\*]{3}[ ]{1,}(*^13)"
  .Replacement.Text = "\1"
  .Replacement.Style = wdStyleHeading3
  .MatchWildcards = True
  .Wrap = wdFindContinue
  .Execute Replace:=wdReplaceAll
End With
Application.ScreenUpdating = True
End Sub

如果要处理多个故事范围，您可以使用：

Sub FindAndReplace3Stars()
Application.ScreenUpdating = False
Dim Rng As Range
For Each Rng In ActiveDocument.StoryRanges
  With Rng.Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Format = False
    .Forward = True
    .Text = "[\*]{3}[ ]{1,}(*^13)"
    .Replacement.Text = "\1"
    .Replacement.Style = wdStyleHeading3
    .MatchWildcards = True
    .Wrap = wdFindContinue
    .Execute Replace:=wdReplaceAll
  End With
Next
Application.ScreenUpdating = True
End Sub

最后，如果有直接格式化，可以更有效地删除它而不使用选择。例如：

Sub FindAndReplace3Stars()
Application.ScreenUpdating = False
With ActiveDocument.Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = "[\*]{3}*^13"
    .MatchWildcards = True
    .Wrap = wdFindStop
    .Execute
  End With
  Do While .Find.Found = True
    .Style = wdStyleHeading3
    .Text = Trim(Split(.Text, "***")(1))
    .Find.Execute
  Loop
End With
Application.ScreenUpdating = True
End Sub

并且，处理所有故事范围：

Sub FindAndReplace3Stars()
Application.ScreenUpdating = False
Dim Rng As Range
For Each Rng In ActiveDocument.StoryRanges
  With Rng
    With .Find
      .ClearFormatting
      .Replacement.ClearFormatting
      .Text = "[\*]{3}*^13"
      .Replacement.Text = ""
      .MatchWildcards = True
      .Wrap = wdFindStop
      .Execute
    End With
    Do While .Find.Found = True
      .Style = wdStyleHeading3
      .Text = Trim(Split(.Text, "***")(1))
      .Find.Execute
    Loop
  End With
Next
Application.ScreenUpdating = True
End Sub