word中对特定内容批量应用样式

 

由于word的查找不支持正则表达式，所以很难匹配VB中的注释，这样也就无法对这些注释批量应用一些样式，于是自己写了一段VBA来对这些注释批量应用样式，代码如下：

 1Sub ToComment()
 2'
 3' Description: 把文档中的VBA注释应用特殊样式
 4' Author: BusyAnt
 5' CreateTime: 2009-03-03 00:01:34
 6'
 7    Dim fRange As Range
 8    
 9    ' 禁止刷屏
    Application.ScreenUpdating = False
    
    Set doc = ActiveDocument
    ' 删除现有的样式
    For i = 1 To doc.Styles.Count - 1
        If doc.Styles(i).NameLocal = "VBA注释" Then
            doc.Styles(i).Delete
        End If
    Next
    
    ' 新建样式
    ActiveDocument.Styles.Add Name:="VBA注释", Type:=wdStyleTypeCharacter
        With ActiveDocument.Styles("VBA注释").Font
            .Bold = False
            .NameFarEast = "仿宋_GB2312"
            .NameAscii = "宋体"
            .NameOther = "宋体"
            .Name = "Arial"
            .Size = 10.5
            .Color = wdColorGreen
        End With
    
    ' 初始化fRange
    Set fRange = ActiveDocument.Range(Start:=0, End:=ActiveDocument.Content.End)
    
    ' 应用
    Call ApplyStyle(fRange)
End Sub

Sub ApplyStyle(ByRef fRange As Range)
    Dim cRange As Range
    Set cRange = ActiveDocument.Range(0, 0)
    With fRange.Find
        .Text = "'"
        .Forward = True
        .Wrap = wdFindStop  ' 搜索到文档末尾截止
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = False
    End With
    fRange.Find.Execute  ' 将改变fRange的起始位置
    If Not fRange.Find.Found Then  ' 找不到就退出
        Exit Sub
    End If
    cRange.Start = fRange.Start
    Debug.Print cRange.Start
    cRange.End = fRange.Paragraphs(1).Range.End
    fRange.Start = cRange.End
    fRange.End = ActiveDocument.Content.End
    cRange.Style = ActiveDocument.Styles("VBA注释")
    Call ApplyStyle(fRange)
End Sub
End Sub