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