Word宏一键交叉引用

Sub Thesis_Final_NoErrors_KeepFormat()
    Dim doc As Document: Set doc = ActiveDocument
    Dim rng As Range, numRng As Range
    Dim refItems As Variant
    Dim i As Long, matchIndex As Long
    Dim citeCount As Long: citeCount = 0
    Dim cleanNum As String
    
    ' 1. 彻底放弃所有会导致报错的 Application 属性
    ' 只保留最基础的屏幕刷新开关
    Application.ScreenUpdating = False
    On Error Resume Next

    ' 2. 直接获取自动编号索引（跳过所有循环扫描，防卡死）
    refItems = doc.GetCrossReferenceItems(wdRefTypeNumberedItem)
    If IsEmpty(refItems) Then
        MsgBox "未识别到自动编号，请确保参考文献有灰色底纹。"
        Exit Sub
    End If

    ' 3. 定义搜索范围
    Set rng = doc.Content
    With rng.Find
        .ClearFormatting
        .Text = "\[[0-9]{1,3}\]"
        .MatchWildcards = True
        .Forward = True
        .Wrap = wdFindStop
    End With

    ' 4. 核心循环：使用 Range 操作，绝不使用 Selection
    Do While rng.Find.Execute
        ' 提取 [12] 中的 12
        cleanNum = rng.Text
        cleanNum = Replace(Replace(cleanNum, "[", ""), "]", "")
        
        matchIndex = 0
        For i = 1 To UBound(refItems)
            ' 匹配编号
            If InStr(1, LTrim(refItems(i)), cleanNum) = 1 Or _
               InStr(1, LTrim(refItems(i)), "[" & cleanNum & "]") = 1 Then
                matchIndex = i
                Exit For
            End If
        Next i

        If matchIndex > 0 Then
            ' 【关键核心】：保留你的方括号，只替换中间的数字
            Set numRng = rng.Duplicate
            numRng.Start = numRng.Start + 1 ' 避开 [
            numRng.End = numRng.End - 1     ' 避开 ]
            
            ' 插入交叉引用：wdNumberRelativeContext 确保只插入编号数字
            numRng.InsertCrossReference ReferenceType:=wdRefTypeNumberedItem, _
                                     ReferenceKind:=wdNumberRelativeContext, _
                                     ReferenceItem:=matchIndex, _
                                     InsertAsHyperlink:=True
            
            ' 将整个 [n] 统一设为上标
            With rng.Font
                .Superscript = True
                .Underline = wdUnderlineNone
                .ColorIndex = wdAuto
            End With
            
            citeCount = citeCount + 1
        End If
        
        ' 每处理一些就给系统喘息机会，防止图片过多导致假死
        If citeCount Mod 10 = 0 Then DoEvents
        rng.Collapse wdCollapseEnd
    Loop

    Application.ScreenUpdating = True
    MsgBox "处理完成！转换了 " & citeCount & " 处引用。" & vbCrLf & "若数字重叠，全选(Ctrl+A)按F9刷新即可。"
End Sub

Sub Remove_Physical_Brackets_Around_Fields()
    Dim fld As Field
    Dim preChar As String, nextChar As String
    Dim i As Long
    
    Application.ScreenUpdating = False
    On Error Resume Next
    
    ' 遍历文档中所有的域
    ' 倒序遍历是为了防止删除字符后索引错乱
    For i = ActiveDocument.Fields.Count To 1 Step -1
        Set fld = ActiveDocument.Fields(i)
        
        ' 检查是否为交叉引用域 (REF 或 NOTEREF)
        If fld.Type = wdFieldRef Or fld.Type = wdFieldNoteRef Then
            
            ' 获取域前后的字符
            preChar = fld.Result.Characters.First.Previous
            nextChar = fld.Result.Characters.Last.Next
            
            ' 如果域前面是 [，删掉它
            If preChar = "[" Then
                fld.Result.Characters.First.Previous.Delete
            End If
            
            ' 如果域后面是 ]，删掉它
            If nextChar = "]" Then
                fld.Result.Characters.Last.Next.Delete
            End If
            
        End If
    Next i
    
    ' 针对可能存在的纯文本重叠 [[ ]] 进行最后清理
    With ActiveDocument.Content.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Text = "\[\["
        .Replacement.Text = "["
        .MatchWildcards = True
        .Execute Replace:=wdReplaceAll
        
        .Text = "\]\]"
        .Replacement.Text = "]"
        .Execute Replace:=wdReplaceAll
    End With

    Application.ScreenUpdating = True
    MsgBox "清理完成！现在应该只剩下一层自带括号的引用了。"
End Sub

视频教程：Word论文一键交叉引用_哔哩哔哩_bilibili