说明:
VBA自定义函数只是减少了手动操作,这里面更大作用的就是文本通配符,建议在通配符有一定水平之后,再结合函数进行使用
一、原文档没有任何样式
二、运行设置标题自定义函数
1、批量设置标题 1
再WPS中,用“[一二三四五六七八九十]{1,3}.*^p”通配所有汉字序号开头的内容,设置为标题 1
2、运行:批量设置标题 2后
同理,通配符相同,函数中的标题 1 改为标题 2
三、运行设置字体自定义函数
运用通配符“^p[一-﨩]{1,12}:”找到所有段落标记开头,中间有1-12汉字的内容,将其设置为蓝色加粗楷体
四、代码
Option Explicit
Sub word文档自动排版_自定义函数应用()
Call 批量设置标题("[一二三四五六七八九十]{1,3}.*^p", "标题 1", True)
Call 批量设置标题("[一二三四五六七八九十]{1,3}.*^p", "标题 2", True)
Call 批量设置字体1("^p[一-﨩]{1,12}:", "楷体", "2", True, True)
End Sub
Function 批量设置字体1(原文字, 字体为, 颜色为, 通配符, Optional ByVal 加粗 As Boolean = False)
Dim rng As Range
Set rng = IIf(Len(Selection.Range.text) <= 1, ActiveDocument.Content, Selection.Range)
With rng.Find
.ClearFormatting
.Replacement.ClearFormatting
.text = 原文字
.Forward = True
.MatchWildcards = 通配符 '通配符开关
With .Replacement
.Font.Name = 字体为
.Font.Name = "Times New Roman"
.Font.ColorIndex = 颜色为 'wdDarkRed
.Font.Bold = 加粗
End With
End With
rng.Find.Execute Replace:=wdReplaceAll
批量设置字体1 = rng.Find.Found
rng.Find.ClearFormatting
rng.Find.Replacement.ClearFormatting
Set rng = Nothing
End Function
Function 批量设置标题(原文字, 标题, 通配符)
Dim rng As Range
Set rng = IIf(Len(Selection.Range.text) <= 1, ActiveDocument.Content, Selection.Range)
With rng.Find
.ClearFormatting
.Replacement.ClearFormatting
.text = 原文字
.Forward = True
.MatchWildcards = 通配符 '通配符开关
With .Replacement
.Style = 标题
End With
End With
rng.Find.Execute Replace:=wdReplaceAll
批量设置标题 = rng.Find.Found
rng.Find.ClearFormatting
rng.Find.Replacement.ClearFormatting
Set rng = Nothing
End Function
五、函数改编与应用
1、改编
上面的《批量设置字体1》和《批量设置标题》,都是可以进行改变的,以《批量设置字体1》函数为例,插入和注析掉一些代码,则可以改为全部替换:
'批量设置字体1_更改为全部替换
Function 全部替换(原文字, 替换为, 通配符)
Dim rng As Range
'设置rng对象,当有选中一部分区域时,只对选中部分进行修改,没有选中时,对全文档进行修改
Set rng = IIf(Len(Selection.Range.text) <= 1, ActiveDocument.Content, Selection.Range)
With rng.Find
'清空查找和替换原来的设置
.ClearFormatting
.Replacement.ClearFormatting
.text = 原文字
.Forward = True
.MatchWildcards = 通配符 '通配符开关
With .Replacement
' .Font.Name = 字体为
'加入替换后的文字
.text = 替换为
' .Font.ColorIndex = 颜色为 'wdDarkRed
' .Font.Bold = 加粗
End With
End With
'执行查找
rng.Find.Execute Replace:=wdReplaceAll
全部替换 = rng.Find.Found
rng.Find.ClearFormatting
rng.Find.Replacement.ClearFormatting
Set rng = Nothing
End Function
2、应用
(1)全部删除题目来源
比如:
1、(2022年高考真题)题目·····················
运行代码替换后:
1、题目·····················
Sub 全部删除题目来源()
Call 全部替换("[(\(]20*[\))]", "", True)
End Sub
(2)批量替换答案和解析
Sub 调整答案和解析()
Call 全部替换("答案", "【答案】", 0)
Call 全部替换("【【答案】】", "【答案】", 0)
Call 全部替换("解析", "【解答】", 0)
End Sub
(3)批量删除答案的内容
注意:“-end-”需要自己手动在每个答案后面添加,标记答案的结束
Call 全部替换("【答案】*-end-", "", True)
(4)批量删除文档中的空行
Sub 批量删除文档中的空行()
Call 全部替换("^l", "^p", False)
Do
If Not 全部替换("^p^p", "^p", False) Then Exit Do
Loop
End Sub