word-VBA 顺题号
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 | Sub 试卷顺题号() '作者 DG-wang '时间 2021-01-28 '用途 试卷重新顺题号 '未解决的问题 “ 1.2008年 ”这样的文本 Const MAX_INDEX As Integer = 20 '设定修改题号的上限值 Dim doc As Document '声明word文档变量 Dim para As Paragraph '声明段落变量 Dim newText As String '声明字符串变量 Dim index As Integer '声明题号变量 Dim Regex As Object '声明正则对象变量 Set Regex = CreateObject( "VBScript.RegExp" ) '实例化正则对象 Regex.Global = True '设置全局属性 Regex.Pattern = "\d{1,2}(.\D)" '设置匹配范式 Set doc = ActiveDocument '实例化文档 index = 0 '初始化题号 '循环所有段落 For i = 1 To doc.Paragraphs.Count Set para = doc.Paragraphs(i) '检查段落特征是否符合预期 If Regex.Test(para.Range.Text) Then index = index + 1 '题号递增1 '替换题号 $1 为匹配范式里括号内的内容 newText = Regex.Replace(para.Range.Text, index & "$1" ) Debug.Print index, "原段落>>" , para.Range.Text, "替换为>>" ; newText 'para.Range.Select para.Range.Text = newText 'Selection.Collapse wdCollapseEnd End If If index = MAX_INDEX Then Exit For Next '释放变量 Set doc = Nothing Set para = Nothing Set Regex = Nothing End Sub |
今天实践了一下,发现之前的做法会将段落内的嵌入图形替换掉,于是重新修改了一下做法
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 | Sub 试卷顺题号() '作者 DG-wang '时间 2021-02-23 '用途 试卷重新顺题号 Const MAX_INDEX As Integer = 20 '设定修改题号的上限值 Dim doc As Document '声明word文档变量 Dim p As Paragraph '声明段落变量 Dim newText As String '声明字符串变量 Dim index As Integer '声明题号变量 Dim Regex As Object '声明正则对象变量 Set Regex = CreateObject( "VBScript.RegExp" ) '实例化正则对象 Regex.Global = True '设置全局属性 Regex.Pattern = "^\s*(\d{1,2}).\s*?\S" '正则表达式 Set doc = ActiveDocument '实例化文档 index = 0 '初始化题号 '循环所有段落 For i = 1 To doc.Paragraphs.Count Set p = doc.Paragraphs(i) If Regex.test(p.Range.Text) Then Set ms = Regex.Execute(p.Range.Text) Debug.Print ms(0) index = index + 1 p.RangeSub 试卷顺题号() '作者 DG-wang '时间 2021-02-23 '用途 试卷重新顺题号 Const MAX_INDEX As Integer = 20 '设定修改题号的上限值 Dim doc As Document '声明word文档变量 Dim p As Paragraph '声明段落变量 Dim newText As String '声明字符串变量 Dim index As Integer '声明题号变量 Dim Regex As Object '声明正则对象变量 Set Regex = CreateObject( "VBScript.RegExp" ) '实例化正则对象 Regex.Global = True '设置全局属性 Regex.Pattern = "^\s*(\d{1,2}).\s*?\S" '正则表达式 Set doc = ActiveDocument '实例化文档 index = 0 '初始化题号 '循环所有段落 For i = 1 To doc.Paragraphs.Count Set p = doc.Paragraphs(i) If Regex.test(p.Range.Text) Then Set ms = Regex.Execute(p.Range.Text) Debug.Print ms(0) index = index + 1 p.Range. Select With Selection.Find .Text = ms(0) .Replacement.Text = Replace(ms(0), ms(0).submatches(0), index) .Execute Replace:=wdReplaceOne End With If index >= MAX_INDEX Then Exit For End If Next i '释放变量 Set doc = Nothing Set p = Nothing Set Regex = Nothing End Sub . Select With Selection.Find .Text = ms(0) .Replacement.Text = Replace(ms(0), ms(0).submatches(0), index) .Execute Replace:=wdReplaceOne End With If index >= MAX_INDEX Then Exit For End If Next i '释放变量 Set doc = Nothing Set p = Nothing Set Regex = Nothing End Sub |
【推荐】编程新体验,更懂你的AI,立即体验豆包MarsCode编程助手
【推荐】凌霞软件回馈社区,博客园 & 1Panel & Halo 联合会员上线
【推荐】抖音旗下AI助手豆包,你的智能百科全书,全免费不限次数
【推荐】博客园社区专享云产品让利特惠,阿里云新客6.5折上折
【推荐】轻量又高性能的 SSH 工具 IShell:AI 加持,快人一步
· DeepSeek 解答了困扰我五年的技术问题
· 为什么说在企业级应用开发中,后端往往是效率杀手?
· 用 C# 插值字符串处理器写一个 sscanf
· Java 中堆内存和栈内存上的数据分布和特点
· 开发中对象命名的一点思考
· DeepSeek 解答了困扰我五年的技术问题。时代确实变了!
· PPT革命!DeepSeek+Kimi=N小时工作5分钟完成?
· What?废柴, 还在本地部署DeepSeek吗?Are you kidding?
· DeepSeek企业级部署实战指南:从服务器选型到Dify私有化落地
· 程序员转型AI:行业分析