VBA Word：将字符样式应用于特定段落样式的前两个单词

Question

我想将字符样式（“粗斜体”）应用于 MS Word 中以“3 Species”样式设置的所有段落的前两个单词（稍后，我还希望另一个宏也可以这样做对于第二个选项卡之后的所有单词以不同的样式）。我知道如何在 InDesign 中完成所有这些操作，但我希望在原始 Word 文档流入 InDesign 之前对其进行设置。

我是新手，不知道如何仅将其应用于前两个单词。我确实将字符样式应用于整个段落或该样式中的特定单词。看起来应该很简单，但到目前为止我只学会了使用查找和替换类型函数，我想我将不得不使用我还不明白的 Range 函数。感谢您的帮助！

Sub Add_Character_Style()
'
' Add_Character_Style Macro
'
  Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Style = "3 Species"
        .Text = ""
        .Replacement.Text = ""
        .Replacement.Style = "Bold Italics"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
   End With
    Selection.Find.Execute Replace:=wdReplaceAll
End Sub

Answer 1

例如：

Sub Demo()
Application.ScreenUpdating = False
With ActiveDocument.Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = "<*>[,. ^s^t]@<*>"
    .Style = "3 Species"
    .Replacement.Text = ""
    .Format = True
    .Forward = True
    .Wrap = wdFindStop
    .MatchWildcards = True
  End With
  Do While .Find.Execute
    .Style = "Bold Italics"
    .Start = .Paragraphs(1).Range.End
  Loop
End With
Application.ScreenUpdating = True
End Sub

Answer 2

试试这个：

Sub Add_Character_Style()
    Dim p As Paragraph
    Dim doc As Document: Set doc = ActiveDocument
    For Each p In doc.Paragraphs
        p.Range.Select
        Selection.Collapse Direction:=wdCollapseStart
        Selection.MoveRight Unit:=wdWord, Count:=2, Extend:=wdExtend
        With Selection
            If .Style = "3 Species" Then .Style = "Bold Italic"
        End With
    Next p
End Sub

编辑： 避免使用 Selection 对象 (Timothy Rylatt)

Sub Add_Character_Style()
   Dim p As Paragraph
   Dim doc As Document: Set doc = ActiveDocument
   Dim rng As Range
   For Each p In doc.Paragraphs
      If p.Range.Style = "3 Species" Then
         Set rng = p.Range
         With rng
            .Collapse Direction:=wdCollapseStart
            .MoveEnd Unit:=wdWord, Count:=2
            .Style = "Bold Italics"
         End With
      End If
   Next p
End Sub

每个宏脚架的进一步编辑：

Sub Add_Character_Style()
Application.ScreenUpdating = False
Dim Para As Paragraph, Rng As Range
For Each Para In ActiveDocument.Paragraphs
  With Para
    If .Style = "3 Species" Then
      If .Range.ComputeStatistics(wdStatisticWords) > 1 Then
        Set Rng = .Range.Words.First
        With Rng
          Do While .ComputeStatistics(wdStatisticWords) < 2
            .MoveEnd wdWord, 1
          Loop
          .Style = "Bold Italic"
        End With
      End If
    End If
  End With
Next
Application.ScreenUpdating = True
End Sub