用VBA自动更正错误的注释引用序号
将扫描pdf文件进行文字识别时，对带圈数字表示的注释引用和注释序号往往会将数字序号认错。例如下面的文件：
这个文件的段落十分有规律：每首诗的标题样式为标题3，标题下面的段落为诗的正文，下面有一个样式为标题4的段落，段落文本为【题解】，此段落下面有若干段落进行说明，接下来有一个样式为标题4的段落，段落文本为【校注】，此段落下面有若干个段落为注释，每条注释一段。针对这样布局的文件，可以用下面的VBA程序将注释引用和注释编号的位置全部修改正确：
Sub 更正注释引用与注释序号的编号()
Dim regEx As Object, aPara As Paragraph, isBody As Boolean, isComm As Boolean
Dim matches, matche As Object, i%, j%
Dim searchRange As Range, tmpRange As Range
Set regEx = CreateObject("VBScript.RegExp")
' 之所以用正则表达式，是因为超过10的带圈数字序号在VBA编辑器中没法输入
' 而Range.Find对象使用的通配符又不支持使用unicode编码
With regEx
.Pattern = "[\u2460-\u2473]" ' 1~20带圈数字序号
.Global = True ' 查找所有匹配
End With
i = 1
Do
Set aPara = ActiveDocument.Paragraphs(i)
If aPara.Style = "标题 3" Then ' 遇到诗标题
i = i + 1 ' 前进一段，进入诗正文
' 设定查找区域为正文范围
Set searchRange = ActiveDocument.Paragraphs(i).Range
' 在正文范围内执行匹配
Set matches = regEx.Execute(searchRange.Text)
' 如果存在带圈数字序号，则遍历每一个带圈数字序号，替换为正确的序数
If matches.Count > 0 Then
For j = 0 To matches.Count - 1
' 重置查找范围为调整后的范围
Set tmpRange = searchRange
With tmpRange.Find
.Text = matches(j).Value
.Wrap = 1 ' wdFindContinue
.Execute ' 找到注释引用
End With
' 根据循环序数计算出正确的带圈数字序号并替换掉原来的文本
tmpRange.Text = ChrW(j + 9312)
' 为防止刚插入的正确带圈数字序号被重复匹配，将查找范围
' 起始位置调整到刚插入的文本之后
searchRange.SetRange tmpRange.End, searchRange.End
Next j
End If
i = i + 1
' 如过遇到【校注】段落
ElseIf aPara.Style = "标题 4" And Left(aPara.Range.Text, 4) = "【校注】" Then
' 选择此段落
ActiveDocument.Paragraphs(i).Range.Select
' 利用Selection.Bookmarks("\headinglevel")取得此标题及所属段落作为查找区域
Set searchRange = Selection.Bookmarks("\headinglevel").Range
' 在该标题所属段落中进行全局查找
Set matches = regEx.Execute(searchRange.Text)
If matches.Count > 0 Then '以下操作与诗正文段落中的操作类似
For j = 0 To matches.Count - 1
Set tmpRange = searchRange
With tmpRange.Find
.Text = matches(j).Value
.Wrap = 1 ' wdFindContinue
.Execute ' 找到注释引用
End With
tmpRange.Text = ChrW(j + 9312)
searchRange.SetRange tmpRange.End, searchRange.End
' 因为每条注释一个段落，所以完成一个匹配项替换应该将段落计数器加1
i = i + 1
Next j
' 将标题段落的计数也加上
i = i + 1
End If
' 碰上不是诗标题和注释区标题的段落，直接累加段落计数器。因为诗正文和
' 注释段落已在前面处理，所以此处的段落实际上就是题注标题及其所属段落
Else
i = i + 1
End If
Loop While i < ActiveDocument.Paragraphs.Count '至全文最后一段终止
End Sub以上代码通用性并不强，只能对特定结构的文档起作用，但仍然演示了正则表达式结合Range.Find进行查找并完成匹配内容定位、查找范围的调整、取得标题及其所属段落区域、数值1-20转换为带圈数字序号（更大的数值大多数字体没有对应的带圈数字序号）等技巧，因而有一定的参考价值。
根据人工智能Kimi的回答，获取标题及其所属段落的Range还有以下方法：
Sub GetTitleAndContentRange()
Dim doc As Document
Dim titlePara As Paragraph
Dim titleRange As Range
Dim contentRange As Range
Set doc = ActiveDocument
' 获取第一个标题段落
Set titlePara = doc.Paragraphs(1)
' 获取标题段落的 Range
Set titleRange = titlePara.Range
' 扩展范围以包含标题下的所有内容
Set contentRange = titleRange.Duplicate
contentRange.Collapse Direction:=wdCollapseEnd
Do While contentRange.Paragraphs(1).Style <> titlePara.Style
contentRange.SetRange Start:=contentRange.Start, End:=contentRange.Paragraphs(1).Range.End
contentRange.Collapse Direction:=wdCollapseEnd
Loop
' 现在 titleRange 包含标题，contentRange 包含标题及其下的内容
' 你可以对这些范围进行操作，例如复制、格式化等
End Sub显然这个方法无论是复杂性还是执行效率都比不上选定标题段落后再使用“Selection.Bookmarks("\headinglevel").Range”获取。上文中要将标题段落本身剔除出searchRange，也只需要再添加一行代码（因为此时标题段落已经被选择）：
searchRange.SetRange Selection.Range.End, searchRange.End