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

问题描述

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

我是新手，不知道如何仅将其应用于前两个词。我确实让它将字符样式应用于整个段落或该样式的特定单词。看起来应该很简单，但到目前为止我只学会了使用 find 和 replace 类型函数，我想我将不得不使用 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

解决方法

例如：

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

,

试试这个：

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