Sub 批量加粗多个指定词语()

Dim rng As Range, arr, i As Integer

Set rng = ActiveDocument.Content

arr = Array("嗣同", "复生")

With rng.Find '在rng变量所指定的范围内查找

.ClearFormatting '不限定格式

.Replacement.ClearFormatting

.Replacement.Font.Bold = ture

.Format = True '不能忽略格式

.MatchCase = True

.Replacement.Text = ""

For i = LBound(arr) To UBound(arr)

.Text = arr(i)

.Execute Replace:=wdReplaceAll

Next

End With

End Sub

Sub 批量加粗多个指定词语2()

Dim txt As String, reg As Object, match As Object

txt = ActiveDocument.Range.Text

Set reg = CreateObject("vbscript.regexp")

With reg

.Global = True

.IgnoreCase = False

.Pattern = "嗣同|复生"

For Each match In .Execute(txt) 'Execute(txt)代表所有匹配项的集合

With match

ActiveDocument.Range(.firstindex, .firstindex + .Length).Font.Bold = True

End With

Next

End With

End Sub