在VBA中结合正则表达式和查找功能给文档添加交叉连接

在VBA中搜索文本有两种方式可用，一种是利用Range.Find对象（更常见的形式可能是Selection.Find，Selection是Range的子类，Selection.Find其实就是特殊的Range.Find），另一种方法是利用正则表达式，但是，这两种方法各有各的问题。
Range.Find对象的问题是正则表达式功能太差。尽管可以通过将MatchWildcards 属性设置为True来使用通配符，但通配符表达式并不完全兼容常用的正则表达式语法，而且不同版本的VBA支持的通配符表达式语法还不一样，例如，我在Word2013中使用通配符表达式(#\d+)|([①-⑨])，它居然因为使用了|操作符，就不能得到预期的结果。
正则表达式的问题则是无法准确定位匹配项在文档中的位置。尽管理论上可以用下面这样的方法定位到匹配项，但是实际运行就会发现除了第一个能定位到，后面的全部会出错：

Dim i As Long
Dim rng As Word.Range
For i = 0 To matchColl.Count - 1' 根据匹配项的位置信息创建Word.Range对象Set rng = doc.Range(matchColl(i).FirstIndex + 1, matchColl(i).FirstIndex + matchColl(i).Length + 1)rng.Select ' 选择第i个匹配项进行其他处理，如打印匹配项内容等    
Next i

为了各取所长避其所短，比较好的思路是将二者结合，先用正则表达式查找匹配项，再用Range.Find来定位匹配项。下面就用这个思路在Word文档主体内容中的注释引用和注释内容中的注释编号之间建立交叉连接来进行一个实践。
我们有这样一个文档：

要在这个文档中建立如图所描述的交叉链接，需要在主体内容的注释引用和注释区的注释编号位置分别插入书签以及连接到对方的超链接。当然，这里的查找内容用简单的通配符表达式也可以完成任务，但是如果编辑过程中出现失误，导致部分注释引用被替换成了别的样式，重新修复的时候就不得不用到|操作符，这时候Range.Find对象就不见得能按预期完成任务了。
下面的宏要求先在文档中选择主体内容，然后运行宏对主体内容进行处理，处理完后再选择注释中的内容，再次运行宏处理注释，交叉链接就建立完毕。我将插入书签和链接的功能写成了如下函数：

Function DealCrossLink(searchRange As Range, regStr As String, chapter As Integer, _Optional useSelection As Boolean = True, Optional contentStr As String = "cont_c", _Optional commentStr As String = "comm_c", Optional formatStr As String = "000", _Optional ignoreCase As Boolean = True)''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 参数说明：'   searchRange：搜索范围'   regStr：应匹配的正则表达式'   chapter:当前书签的章节序号'   useSelection：插入超链接时显示的文本是否用在文档中选择的文本，默认为True，否则显示#加阿拉伯数字'   contentStr,commentStr:区分主体内容区和注释区的字符串'   formatStr:注释引用序数扩充到固定长度所用的格式字符串，默认扩充为至少3字符（"000"）'   ignoreCase：匹配内容时是否忽略大小写，默认为True'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''Dim regEx As RegExpDim match, matches As ObjectDim tmpRange As RangeDim i%, serial$, hyperText$Set regEx = CreateObject("VBScript.RegExp")With regEx.Global = True.ignoreCase = ignoreCase.Pattern = regStr 'End WithSet matches = regEx.Execute(searchRange.Text) ' 在搜索范围内执行匹配操作searchRange.Collapse Direction:=wdCollapseStart ' 将搜搜范围折叠到开头For Each match In matchesSet tmpRange = searchRangeWith tmpRange.Find.Text = match.Value.Forward = True.Wrap = 1 ' wdFindContinue.Execute ' 执行查找，定位匹配项的位置If tmpRange.Find.found Then' 注释引用和注释区注释编号设置为上标tmpRange.Font.Superscript = -1i = i + 1 ' 计算当前书签序号，用于书签命名serial = "_" & Format(i, formatStr) ' 将序号扩充为等长字符串，默认长度为3（"000"）With ActiveDocument.Bookmarks.Add Range:=tmpRange, Name:=contentStr & chapter & serial.DefaultSorting = wdSortByName.ShowHidden = FalseEnd WithIf useSelection Then hyperText = tmpRange.Text Else hyperText = "#" & iActiveDocument.Hyperlinks.Add Anchor:=tmpRange, Address:="", _SubAddress:=commentStr & chapter & serial, ScreenTip:="", TextToDisplay:=hyperText' 调整搜索范围起始位置，准备定位下一个匹配项searchRange.SetRange Start:=tmpRange.End, End:=searchRange.EndEnd IfEnd WithNext matchEnd Function

上面的代码也展示了在选定区域中进行查找的方法。
调用上述函数的代码如下：

Sub test()Dim chapter%    chapter = 1' 处理主体内容中的书签和超链接，超链接文本用文档中的匹配文本DealCrossLink Selection.Range, regStr, chapter' 处理注释内容中的书签和超链接，超链接文本用文档中的匹配文本
'    DealCrossLink Selection.Range, regStr, chapter, contentStr:="comm_c", commentStr:="cont_c"' 处理主体内容中的书签和超链接，超链接文本用#号连接阿拉伯数字编号
'	DealCrossLink Selection.Range, regStr, chapter，False
'    ' 处理注释内容中的书签和超链接，超链接文本用#号连接阿拉伯数字编号
'    DealCrossLink Selection.Range, regStr, chapter, contentStr:="comm_c", commentStr:="cont_c", FalseEnd Sub

可以根据需要，将以上代码中最后四行具体调用函数的语句选择一条执行。
下面是选择主体内容后执行第一条语句的结果：

下面是选择注释内容执行第四条语句的结果：

主体内容中的“①”与注释内容中的“#1”之间成功建立起了交叉链接，其它编号也是如此。
如果觉得每次选一个段落有点麻烦，可以考虑在诗标题和校注前先插入连续型分节符（可参阅文档目录、页眉和文档章节标题之间插入相互链接的最佳实践中的过程Sub 指定级别标题前插入分节符()），然后遍历档中的所有节，各节第一段文本为“【校注】”的即为注释区，否则当做主体内容区，然后在调用DealCrossLink函数时将section.Range取代Selection.Range作为第一个参数传入，即可无需选择内容建立全文的交叉链接。示例代码如下：

Sub 全文主体内容的注释引用与注释区注释序号之间建立交叉链接()Dim aSec As Section, chapter%, regStr$, addChapter As Boolean'是否递增章节序号。只有处理完了一个注释区后才递增章节号，以确保对应的主体内容和注释章节号相同addChapter = TrueregStr = "〔\d+〕"For Each aSec In ActiveDocument.SectionsIf addChapter Then chapter = chapter + 1If Left(aSec.Range.Paragraphs(1).Range.Text, 4) = "【注释】" ThenDealCrossLink aSec.Range, regStr, chapter, contentStr:="comm_c", commentStr:="cont_c"addChapter = TrueElseDealCrossLink aSec.Range, regStr, chapteraddChapter = FalseEnd IfNext
End Sub