zoukankan      html  css  js  c++  java
  • word-VBA 顺题号

    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
    

      今天实践了一下,发现之前的做法会将段落内的嵌入图形替换掉,于是重新修改了一下做法

    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
    

      

  • 相关阅读:
    入浅出MySQL 8.0 lock_sys锁相关优化 原创 腾讯数据库技术 腾讯数据库技术 2021-03-08
    以模型为中心,携程契约系统的演进
    bs
    外观模式
    设计接口时严格区分map、list,方便前端使用。
    t
    The HyperText Transfer Protocol (HTTP) 504
    入理解 epoll 原创 冯志明 Qunar技术沙龙 2021-03-10
    一次XSS和CSRF的组合拳进攻 (CSRF+JSON)
    当程序员具备了抽象思维 从码农到工匠 阿里巴巴中间件 2021-03-09
  • 原文地址:https://www.cnblogs.com/nextseven/p/14338622.html
Copyright © 2011-2022 走看看