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

  

posted @   wangway  阅读(225)  评论(0编辑  收藏  举报
编辑推荐:
· DeepSeek 解答了困扰我五年的技术问题
· 为什么说在企业级应用开发中,后端往往是效率杀手?
· 用 C# 插值字符串处理器写一个 sscanf
· Java 中堆内存和栈内存上的数据分布和特点
· 开发中对象命名的一点思考
阅读排行:
· DeepSeek 解答了困扰我五年的技术问题。时代确实变了!
· PPT革命!DeepSeek+Kimi=N小时工作5分钟完成?
· What?废柴, 还在本地部署DeepSeek吗?Are you kidding?
· DeepSeek企业级部署实战指南:从服务器选型到Dify私有化落地
· 程序员转型AI:行业分析
点击右上角即可分享
微信分享提示