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

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



## 用法

### 前期准备

脚本支持的格式如下：

1. 纯文本方括号引用

![image.png|100x100](/static/img/ea408108cb57c7508de16b49b60c1c8d.image.webp)

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


![image.png](/static/img/ee5c528313d6656f52fa3116b6e97739.image.webp)

### 使用

打开宏管理器

![image.png](/static/img/6dd7f0a8239ba6cda2f9cdd77c2f36bf.image.webp)

新建

![image.png](/static/img/586760ce0d879fabcd124be9da338def.image.webp)

粘贴[代码](#代码)

![image.png](/static/img/d83a7952e106d09740c030c8ac53b623.image.webp)

打开引用管理

![image.png](/static/img/1726e0321ca16438ecc8e78c8b2bccde.image.webp)

勾选 Microsoft Scripting Runtime

![image.png](/static/img/f2cef19274d6a27a2b115108b19e8cca.image.webp)

确定退出，运行！

![image.png](/static/img/6216f111b4668b36fade7da94e3c07e8.image.webp)

Done

![image.png](/static/img/44d8ca19a136ac7d976bbfd6da8f3fa0.image.webp)

![image.png](/static/img/9aa729a135ddf3bde0d9e7828542a78b.image.webp)

## 代码

```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



```

Word自动替换纯文本文献引用为交叉引用

原来的博客站用的是[Rin](https://github.com/openRin/Rin)这个项目，虽然白嫖cloudflare是爽了，但用起来也实在没那么方便。

最近刚好hk的服务器上线了，就迁移（~~明明原来的博客站在线的时候啥都没写~~）到Vanblog这个项目了。

刚好也逐渐适应读研生活了，该开始写点东西了




![pimicococ_1860699674384142357_photo_1_20241124.jpg](/static/img/6a44656b87694dd5cd30b2fae1c1f0b8.pimicococ_1860699674384142357_photo_1_20241124.webp)
（试试图床）