如何扩展Word VBA Range.Find返回的范围，直到段落结束

Question

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

防爆。

*** Day 1

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

*** Day 2

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

我试图选择那些行，删除3个星的单词，并将该行作为heading3。

我也避免（最佳实践？）在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 + Spacebar作为用户并强制选择显示可能已通过直接字体格式覆盖的段落样式的格式。

然后有必要在继续查找之前折叠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