Word VBA: 按照章节号进行查找、跳转、选择,以及章节号比较

Word自带的查找章节号功能并不好用,有时甚至有些莫名其妙。当文档篇幅很大时,以下几个VBA函数可以高效处理文档工作。

  • 按章节号查找
Function iFindChapter&(s$, a&, b&)
''' 用二分法根据章节号找指定章节,返回ListParagraph的索引
    Dim i&, m&, cmp&, x$
    Dim p As Paragraph
    Dim found As Boolean
    
    If a > b Then
        iFindChapter = -1
        Exit Function
    End If
    
    m = Round((a + b) / 2)  ' 中点
    
    found = False  ' 是否找到带序列号的章节标题
    i = m
    Do While (i <= b)
        Set p = ActiveDocument.ListParagraphs(i)
        If p.OutlineLevel <> wdOutlineLevelBodyText Then
            found = True
            Exit Do
        End If
        i = i + 1
    Loop
    
    If found Then
        If p.OutlineLevel = wdOutlineLevel1 Then
            x = CStr(p.Range.ListFormat.ListValue)
        Else
            x = p.Range.ListFormat.ListString
        End If
        
        cmp = iCompareChapterNo(x, s)
        If cmp = 0 Then  ' 找到
            iFindChapter = i
        ElseIf cmp > 0 Then  ' 找过头了
            iFindChapter = iFindChapter(s, a, m - 1) ' 往前找
        Else  ' 还没到
            iFindChapter = iFindChapter(s, i + 1, b) ' 往后找
        End If
    Else
        iFindChapter = iFindChapter(s, a, m - 1) ' 往前找
    End If
       
End Function
  • 跳转到制定章节、拷贝连续章节
Sub ChaptersGo()
''' 跳转到指定章节;拷贝连续章节

    Dim strNo$, sa$, sb$, i&, j&, n&, ia&, ib&, lv&
    Dim rng As Range
    Dim bMultiChapters As Boolean
    
    strNo = InputBox("举例:" & vbCrLf & "· 跳转到指定章节:10.1" & vbCrLf & "· 选中多个连续章节:10.1-10.3", "请输入章节号")
    If strNo = "" Then Exit Sub
    n = InStr(strNo, "-")  
    If n > 0 Then
        bMultiChapters = True
        sa = Trim(Left(strNo, n - 1))
        sb = Trim(Mid(strNo, n + 1))
    Else
        bMultiChapters = False
        sa = strNo
    End If
    
    
    i = 0
    n = ActiveDocument.ListParagraphs.Count
    If n >= 1 Then i = iFindChapter(sa, 1, n)
    If i > 0 Then
        If Not bMultiChapters Then  ' 跳转到指定章节
            Set rng = ActiveDocument.ListParagraphs(i).Range
            rng.Select
        Else  ' 拷贝连续章节
            j = iFindChapter(sb, i + 1, n)
            If j > 0 Then
                ia = ActiveDocument.ListParagraphs(i).Range.Start
                
                lv = ActiveDocument.ListParagraphs(j).OutlineLevel
                Set rng = ActiveDocument.ListParagraphs(j).Range
                Do
                    ib = rng.End
                    Set rng = rng.Next(wdParagraph)
                    If rng Is Nothing Then Exit Do
                Loop While rng.ParagraphFormat.OutlineLevel > lv
                
                Set rng = ActiveDocument.Range(ia, ib)
                rng.Select
            Else
                MsgBox "Chapter " & sb & " not found!"
            End If
        End If
    Else
        MsgBox "Chapter " & sa & " not found!"
    End If
    
End Sub
  • 比较章节号
Public Function iCompareChapterNo&(s1$, s2$)
''' 比较两个章节号大小 e.g. 3.2 < 10.1.1
   
   Dim ss1, ss2
   Dim n1&, n2&, n&, i&
   
   s1 = IIf(Right(s1, 1) = ".", Left(s1, Len(s1) - 1), s1)
   s2 = IIf(Right(s2, 1) = ".", Left(s2, Len(s2) - 1), s2)
   
   ss1 = Split(s1, ".")
   ss2 = Split(s2, ".")
   
   n1 = UBound(ss1)
   n2 = UBound(ss2)
   n = IIf(n1 <= n2, n1, n2)
   
   For i = 0 To n
       If CInt(ss1(i)) > CInt(ss2(i)) Then 
           iCompareChapterNo = 1
           Exit Function
       ElseIf CInt(ss1(i)) < CInt(ss2(i)) Then
           iCompareChapterNo = -1
           Exit Function
       End If
   Next
   
   iCompareChapterNo = n1 - n2
   
End Function
评论 1
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值