Zotero交叉引用代码及使用方法-不求人资源站

本代码基于Word和WPS的宏功能，所以使⽤前需要确保宏功能是启⽤状态的，使⽤Zotero软件插⼊好参考⽂献并且确保格式正确，才能顺利运⾏该宏代码！

配置成功，永久都可以使⽤的。建议⼤家再看这个之前先去详细阅读⼀下使⽤注意事项。

这个宏代码⽀持Word和WPS，苹果电脑和Windows电脑都⽀持，配置⽅法基本上也都是⼀样的，⼤同⼩异！！

Public Sub ZoteroLinkCitation()
    ' 声明变量(@小红书软件管家)
    Dim nStart As Long, nEnd As Long
    Dim title As String, titleAnchor As String
    Dim fieldCode As String, numOrYear As String
    Dim n1 As Long, n2 As Long
    Dim aField As Field
    Dim Paper_i As Integer
    Dim j As Integer
    
    ' 保存当前选择位置
    nStart = Selection.Start
    nEnd = Selection.End
    Application.ScreenUpdating = False
    
    On Error GoTo ErrorHandler
    
    ' 步骤1：查找并标记Zotero参考文献部分
    ActiveWindow.View.ShowFieldCodes = True
    Selection.Find.ClearFormatting
    
    With Selection.Find
        .Text = "^d ADDIN ZOTERO_BIBL"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    
    ' 执行查找
    If Selection.Find.Execute Then
        ' 为参考文献部分添加书签
        With ActiveDocument.Bookmarks
            If .Exists("Zotero_Bibliography") Then
                .Item("Zotero_Bibliography").Delete
            End If
            .Add Range:=Selection.Range, name:="Zotero_Bibliography"
            .DefaultSorting = wdSortByName
            .ShowHidden = True
        End With
    Else
        MsgBox "未找到Zotero参考文献部分！", vbExclamation
        GoTo CleanUp
    End If
    
    ActiveWindow.View.ShowFieldCodes = False
    
    ' 步骤2：处理每个Zotero引用字段
    For Each aField In ActiveDocument.Fields
        ' 检查是否为Zotero文内引用
        If InStr(aField.Code, "ADDIN ZOTERO_ITEM") > 0 Then
            fieldCode = aField.Code
            Paper_i = 1
            
            ' 解析字段中的每个引用项目
            Do While InStr(fieldCode, """title"":""") > 0
                ' 提取标题
                n1 = InStr(fieldCode, """title"":""") + Len("""title"":""")
                n2 = InStr(Mid(fieldCode, n1), """,""")
                
                If n2 > 0 Then
                    n2 = n2 + n1 - 1
                    title = Mid(fieldCode, n1, n2 - n1)
                    
                    ' 创建书签锚点名称（清理特殊字符）
                    titleAnchor = CleanAnchorName(title)
                    
                    ' 在参考文献中查找对应条目并添加书签
                    If FindAndBookmarkReference(title, titleAnchor) Then
                        ' 为引用创建超链接
                        Call CreateHyperlinkForCitation(aField, titleAnchor, Paper_i)
                        Paper_i = Paper_i + 1
                    End If
                    
                    ' 移除已处理的部分
                    fieldCode = Mid(fieldCode, n2 + 1)
                Else
                    Exit Do
                End If
            Loop
        End If
    Next aField
    
CleanUp:
    ' 恢复原始选择
    ActiveDocument.Range(nStart, nEnd).Select
    Application.ScreenUpdating = True
    MsgBox "Zotero交叉引用处理完成！", vbInformation
    Exit Sub
    
ErrorHandler:
    Application.ScreenUpdating = True
    MsgBox "处理过程中出现错误：" & Err.Description, vbCritical
    Resume CleanUp
End Sub

' 辅助函数：清理锚点名称
Private Function CleanAnchorName(inputText As String) As String
    Dim cleanText As String
    Dim i As Integer
    Dim invalidChars As String
    
    ' 定义无效字符
    invalidChars = " #&:,-?'.()!@$%^*+=[]{}|\"
    
    cleanText = inputText
    
    ' 替换无效字符为下划线
    For i = 1 To Len(invalidChars)
        cleanText = Replace(cleanText, Mid(invalidChars, i, 1), "_")
    Next i
    
    ' 限制长度并移除连续的下划线
    cleanText = Left(cleanText, 40)
    Do While InStr(cleanText, "__") > 0
        cleanText = Replace(cleanText, "__", "_")
    Loop
    
    ' 移除开头和结尾的下划线
    If Left(cleanText, 1) = "_" Then cleanText = Mid(cleanText, 2)
    If Right(cleanText, 1) = "_" Then cleanText = Left(cleanText, Len(cleanText) - 1)
    
    CleanAnchorName = cleanText
End Function

' 辅助函数：在参考文献中查找并添加书签
Private Function FindAndBookmarkReference(title As String, anchorName As String) As Boolean
    On Error GoTo ErrorHandler
    
    ' 跳转到参考文献部分
    Selection.GoTo What:=wdGoToBookmark, name:="Zotero_Bibliography"
    
    ' 查找标题
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = Left(title, 100) ' 使用标题的前100个字符进行搜索
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindAsk
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    
    If Selection.Find.Execute Then
        ' 选择整个段落
        Selection.Paragraphs(1).Range.Select
        
        ' 添加书签
        With ActiveDocument.Bookmarks
            If .Exists(anchorName) Then
                .Item(anchorName).Delete
            End If
            .Add Range:=Selection.Range, name:=anchorName
            .DefaultSorting = wdSortByName
            .ShowHidden = True
        End With
        
        FindAndBookmarkReference = True
    Else
        FindAndBookmarkReference = False
    End If
    
    Exit Function
    
ErrorHandler:
    FindAndBookmarkReference = False
End Function

' 辅助函数：为引用创建超链接
Private Sub CreateHyperlinkForCitation(targetField As Field, anchorName As String, paperIndex As Integer)
    Dim commaPositions() As Long
    Dim startPosition As Long, commaPosition As Long
    Dim numOrYear As String
    Dim originalStyle As style
    Dim i As Integer
    
    On Error GoTo ErrorHandler
    
    ' 选择字段
    targetField.Select
    
    ' 找到所有逗号位置
    startPosition = 1
    ReDim commaPositions(1 To 1)
    
    ' 查找逗号位置（假设作者和年份用逗号分隔）
    Do
        commaPosition = InStr(startPosition, Selection.Text, ",")
        If commaPosition > 0 Then
            commaPositions(UBound(commaPositions)) = commaPosition
            startPosition = commaPosition + 1
            ReDim Preserve commaPositions(1 To UBound(commaPositions) + 1)
        End If
    Loop While commaPosition > 0
    
    ' 定位到特定的引用项
    With Selection.Find
        .Text = "^#"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    
    If Selection.Find.Execute Then
        Selection.MoveLeft Unit:=wdCharacter, Count:=1
        
        ' 根据paperIndex移动到正确位置
        If UBound(commaPositions) >= paperIndex And paperIndex > 1 Then
            Selection.MoveRight Unit:=wdCharacter, Count:=commaPositions(paperIndex - 1)
        End If
        
        Selection.Find.Execute
        Selection.MoveLeft Unit:=wdCharacter, Count:=1
        Selection.MoveRight Unit:=wdWord, Count:=1, Extend:=wdExtend
        
        numOrYear = Trim(Selection.Range.Text)
        
        ' 保存原始样式
        Set originalStyle = Selection.style
        
        ' 创建超链接
        With ActiveDocument.Hyperlinks.Add(Anchor:=Selection.Range, Address:="", SubAddress:=anchorName, ScreenTip:="点击跳转到参考文献", TextToDisplay:=numOrYear)
            .Range.Font.Underline = wdUnderlineNone  ' 移除下划线
            .Range.Font.Color = wdColorAutomatic      ' 设置为自动颜色
        End With
    End If
    
    Exit Sub
    
ErrorHandler:
    ' 处理错误但不中断整个过程
End Sub

一、Microsoft Word 中配置

先检查宏功能是否开启，必须先启⽤宏功能。