查找文本的更好方法,select 到段落开头,并重新格式化

Better way to find text, select to start of paragraph, and reformat

我正在 Word 中编写一个宏来查找左括号,select 从该字符到段落的开头,然后将 selected 文本重新格式化为小型大写字母。公平警告,我对 VBA 一无所知,我根据网上找到的示例将这些宏组合在一起。

宏的最后一部分将光标移动到下一段的开头,以便我可以再次 运行。我想循环,但是我还没有想出如何为循环设置一个停止点。

下面的宏有效,但必须有更好的方法来实现。此方法会导致大量屏幕闪烁,并且会一直占用 运行.

Sub References()
'
' References Macro

'this part selects text until it finds an open parenthesis
Dim flag As Boolean
flag = True
While flag = True
    Selection.MoveRight Unit:=wdCharacter, Count:=1, _
    Extend:=wdExtend
    'checks the last character to see if its a open parenthesis
    If Strings.Right(Selection.Range.Text, 1) = "(" Then
        'if it was an open parenthesis the loop flag will end
        flag = False
    End If
Wend

'this part reformats the text
    With Selection.Font
        .Name = "Times New Roman"
        .Size = 12
        .Bold = False
        .Italic = False
        .Underline = wdUnderlineNone
        .UnderlineColor = wdColorAutomatic
        .StrikeThrough = False
        .DoubleStrikeThrough = False
        .Outline = False
        .SmallCaps = True
        .AllCaps = False
        .Color = wdColorAutomatic
        .Spacing = 0
        .Scaling = 100
        .Position = 0
        .Kerning = 1
    End With

'this part moves the cursor to the beginning of the next paragraph
    Selection.HomeKey Unit:=wdLine
    Selection.MoveDown Unit:=wdParagraph, Count:=1

End Sub

例如,使用查找(这比测试每个字符要快得多):

Sub Demo()
Application.ScreenUpdating = False
Dim i As Long
With ActiveDocument.Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = "("
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindStop
    .Format = False
    .MatchWildcards = False
  End With
  Do While .Find.Execute
    i = i + 1
    .Start = .Paragraphs.First.Range.Start
    .Font.SmallCaps = True
    .Start = .Paragraphs.First.Range.End
  Loop
End With
Application.ScreenUpdating = True
MsgBox i & " instances processed."
End Sub