最近在做课题组里的项目，总会有要求把之前的英文文献翻译成中文然后填充到报告里的事情，这时候甲方会对格式提各种要求，最麻烦的就是交叉引用：翻译过来的文件基本都是纯文本，创建交叉引用只能一个个手动替换。

为了解放双手一劳永逸，就写了个Word的宏来做这件事。

用法

前期准备

脚本支持的格式如下：

1. 纯文本方括号引用

2. 格式为[1] 的自定义列表（尾空格可有可无）

使用

打开宏管理器

新建

粘贴代码

打开引用管理

勾选 Microsoft Scripting Runtime

确定退出，运行！

Done

代码

VB
' 需要启用 Microsoft Scripting Runtime

' 指定参考文献开始的页码，不指定则设为0
Private Const REFERENCE_START_PAGE As Integer = 0

' ============================================
' =================  主程序  =================
' ============================================
Sub AutoCreatePaperCrossReferences()
    Application.ScreenUpdating = True
    
    Dim doc As Document
    Set doc = ActiveDocument
    
    Dim refCache As Object
    Set refCache = CreateObject("Scripting.Dictionary")
    
    Debug.Print "=================================================="
    Debug.Print "宏开始运行 (时间: " & Now & ")"
    
    ' --- 阶段一：构建缓存  ---
    BuildReferenceCache doc, refCache
    
    If refCache.count = 0 Then
        MsgBox "错误：未能成功构建参考文献缓存。可能是文档中没有找到格式为 [数字] 的可引用项。宏已终止。", vbCritical
        Application.ScreenUpdating = True
        Exit Sub
    End If
    Debug.Print "缓存构建成功，找到 " & refCache.count & " 个有效参考文献条目。"

    ' --- 阶段二：查找所有替换 ---
    Dim tasks As New Collection
    Dim findRange As Range
    Set findRange = doc.Content
    findRange.End = doc.GoTo(What:=wdGoToPage, Which:=wdGoToAbsolute, count:=REFERENCE_START_PAGE).Start
    
    With findRange.Find
        .ClearFormatting
        .text = "\[([0-9]{1,})\]"
        .MatchWildcards = True
        .Wrap = wdFindStop
    End With
    
    Do While findRange.Find.Execute
        Dim refNum As Long: refNum = 0
        On Error Resume Next
        refNum = CLng(Replace(Replace(findRange.text, "[", ""), "]", ""))
        On Error GoTo 0
        If refNum > 0 And refCache.Exists(refNum) Then
            tasks.Add Array(findRange.Duplicate, refNum)
        End If
    Loop
    Debug.Print "查找任务完成，共发现 " & tasks.count & " 个待替换项。"
    
    ' --- 阶段三：执行替换 ---
    Debug.Print "开始执行替换操作"
    Dim i As Long
    Dim task As Variant
    Dim rangeToReplace As Range
    Dim reliableIndex As Long
    
    For i = tasks.count To 1 Step -1
        task = tasks(i)
        Set rangeToReplace = task(0)
        refNum = task(1)
        reliableIndex = refCache(refNum)
        
        Debug.Print "  执行替换 " & i & "/" & tasks.count & ": 将文本 '[" & refNum & "]' 替换为指向段落索引 " & reliableIndex & " 的交叉引用。"
        
        rangeToReplace.text = ""
        rangeToReplace.InsertCrossReference _
            ReferenceType:=wdRefTypeNumberedItem, _
            ReferenceKind:=wdNumberFullContext, _
            ReferenceItem:=reliableIndex, _
            InsertAsHyperlink:=True, _
            IncludePosition:=False
    Next i
    
    Debug.Print "所有替换操作已完成"
    Debug.Print "宏运行结束。 (时间: " & Now & ")"
    Debug.Print "=================================================="

    Application.ScreenUpdating = True
    MsgBox tasks.count & " 个纯文本引用已成功转换为交叉引用！", vbInformation
End Sub

Private Sub BuildReferenceCache(doc As Document, ByRef finalCache As Object)
    Dim officialItems As Variant
    On Error Resume Next
    officialItems = doc.GetCrossReferenceItems(wdRefTypeNumberedItem)
    On Error GoTo 0
    If IsEmpty(officialItems) Then
        Debug.Print "错误: GetCrossReferenceItems 未能返回任何项目。"
        Exit Sub
    End If

    Dim i As Long
    Dim currentItem As String
    Dim refNum As Long
    
    For i = LBound(officialItems) To UBound(officialItems)
        currentItem = Trim(officialItems(i))
        
        If currentItem Like "[[]#*" Then
            On Error Resume Next
            Dim startPos As Integer, endPos As Integer
            startPos = InStr(currentItem, "[")
            endPos = InStr(currentItem, "]")
            
            refNum = 0
            If endPos > startPos Then
                refNum = CLng(Mid(currentItem, startPos + 1, endPos - startPos - 1))
            End If
            On Error GoTo 0
            
            If refNum > 0 And Not finalCache.Exists(refNum) Then
                finalCache.Add refNum, i
                Debug.Print "  缓存成功: 引用编号 [" & refNum & "] -> 段落索引 " & i
            End If
        End If
    Next i
End Sub