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

如何扩大Word VBA Range的范围。查找到段落末尾

2 个答案: