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

 

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

Code
 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    ' 禁止刷屏
10    Application.ScreenUpdating = False
11    
12    Set doc = ActiveDocument
13    ' 删除现有的样式
14    For i = 1 To doc.Styles.Count - 1
15        If doc.Styles(i).NameLocal = "VBA注释" Then
16            doc.Styles(i).Delete
17        End If
18    Next
19    
20    ' 新建样式
21    ActiveDocument.Styles.Add Name:="VBA注释", Type:=wdStyleTypeCharacter
22        With ActiveDocument.Styles("VBA注释").Font
23            .Bold = False
24            .NameFarEast = "仿宋_GB2312"
25            .NameAscii = "宋体"
26            .NameOther = "宋体"
27            .Name = "Arial"
28            .Size = 10.5
29            .Color = wdColorGreen
30        End With
31    
32    ' 初始化fRange
33    Set fRange = ActiveDocument.Range(Start:=0, End:=ActiveDocument.Content.End)
34    
35    ' 应用
36    Call ApplyStyle(fRange)
37End Sub
38
39Sub ApplyStyle(ByRef fRange As Range)
40    Dim cRange As Range
41    Set cRange = ActiveDocument.Range(0, 0)
42    With fRange.Find
43        .Text = "'"
44        .Forward = True
45        .Wrap = wdFindStop  ' 搜索到文档末尾截止
46        .Format = False
47        .MatchCase = False
48        .MatchWholeWord = False
49        .MatchByte = False
50        .MatchAllWordForms = False
51        .MatchSoundsLike = False
52        .MatchWildcards = False
53    End With
54    fRange.Find.Execute  ' 将改变fRange的起始位置
55    If Not fRange.Find.Found Then  ' 找不到就退出
56        Exit Sub
57    End If
58    cRange.Start = fRange.Start
59    Debug.Print cRange.Start
60    cRange.End = fRange.Paragraphs(1).Range.End
61    fRange.Start = cRange.End
62    fRange.End = ActiveDocument.Content.End
63    cRange.Style = ActiveDocument.Styles("VBA注释")
64    Call ApplyStyle(fRange)
65End Sub
66End Sub

转载于:https://www.cnblogs.com/ningj3/archive/2009/03/03/1401873.html