word快速为引用添加超链接

不符合本科论文要求，如因此导致格式错误概不负责

VB实现快速对文中所有的类似 [1]​ [12]​ 的文本进行上角标处理，并添加超链接到对应的引用文本。

引用文本格式为

1. 引用1
2. 引用2

具体的，

1. 数字后的点必为英文句号
2. 数字为自动编号或手动编号均可

符合上述条件的，按下文步骤使用：

（如了解如何运行VB脚本请跳过）

1. 打开文档
2. 快捷键 Alt+F11​
3. 顶部菜单 插入-模块
4. 按下 F5​

代码：

Sub CreateHyperlinkAndSuperscript()
    Dim doc As Document
    Set doc = ActiveDocument

    Dim regExRef As Object
    Set regExRef = CreateObject("VBScript.RegExp")
    regExRef.Pattern = "^([0-9]+)\\..+"
    regExRef.IgnoreCase = True
    regExRef.Global = False

    Dim para As Paragraph, refNumber As String
    For Each para In doc.Paragraphs
        Dim paraText As String
        paraText = Trim(para.Range.Text)
        If regExRef.Test(paraText) Then
            Dim m As Object
            Set m = regExRef.Execute(paraText)
            refNumber = m(0).SubMatches(0)
            On Error Resume Next
            para.Range.Bookmarks.Add Name:="ref" & refNumber
            On Error GoTo 0
        End If
    Next para

    Dim regExCitation As Object
    Set regExCitation = CreateObject("VBScript.RegExp")
    regExCitation.Pattern = "\\[(\\d+)\\]"
    regExCitation.IgnoreCase = True
    regExCitation.Global = True

    Dim rngStory As Range
    For Each rngStory In doc.StoryRanges
        Dim rng As Range
        Set rng = rngStory.Duplicate
        With rng.Find
            .ClearFormatting
            .Text = "\\[[0-9]{1,}\\]"
            .MatchWildcards = True
            Do While .Execute
                Dim foundText As String
                foundText = rng.Text
                If regExCitation.Test(foundText) Then
                    Dim citMatches As Object
                    Set citMatches = regExCitation.Execute(foundText)
                    Dim num As String
                    num = citMatches(0).SubMatches(0)
                    If doc.Bookmarks.Exists("ref" & num) Then
                        ' 设置为上角标
                        rng.Font.Superscript = True
                        ' 避免重复添加超链接
                        Dim hl As Hyperlink
                        Dim hyperlinkExists As Boolean
                        hyperlinkExists = False
                        Dim i As Integer
                        For i = 1 To doc.Hyperlinks.Count
                            Set hl = doc.Hyperlinks(i)
                            If rng.Start >= hl.Range.Start And rng.End <= hl.Range.End Then
                                hyperlinkExists = True
                                Exit For
                            End If
                        Next i
                        If Not hyperlinkExists Then
                            doc.Hyperlinks.Add Anchor:=rng, Address:="", SubAddress:="ref" & num, ScreenTip:="跳转到引用文献"
                        End If
                    End If
                End If
                rng.Collapse Direction:=wdCollapseEnd
            Loop
        End With
    Next rngStory

    MsgBox "完成！"
End Sub