Zotero在word中插入带超链接的参考文献/交叉引用/跳转参考文献

Zotero以其丰富的插件而闻名，使用起来十分的带劲，最重要的是它是免费的、不卡顿，不像某专业软件。

然而Zotero在word插入参考文献时，无法为参考文献添加超链接，这是一个不得不提的遗憾。

不过，有大佬已经写出了基于Word VBA语言的代码，可以为Zotero在Word中的参考文献一键增加超链接！源代码如下所示：

Word: Possibility to link references and bibliography in a document? - Zotero ForumsZotero is a free, easy-to-use tool to help you collect, organize, cite, and share research.https://forums.zotero.org/discussion/comment/148343/#Comment_148343

参考教程：

Zotero-word中引用跳转到参考文献/建立超链接-引用格式文章浏览阅读7.4k次，点赞10次，收藏25次。该方法根据标题将作者日期或数字样式引用链接到他们的参考文献条目。https://blog.csdn.net/weixin_47244593/article/details/129072589

不过，这个代码在运行的时候，我遇到了一些严重的问题：

-1. 当一个位置同时引用的参考文献>2，就只能为前两个文献添加超链接，且第3个以及之后的参考文献。

-2. 引用了同一个作者的两篇及以上的参考文献，只能给第一个文献添加超链接，第二个就无法添加。

-3. 部分参考文献添加超链接失败，提示Add BookMarks失败。

作为对VBA语言一窍不通的我，硬着头皮啃了一下源代码，对于问题1和问题2，终于发现了问题所在：**在同一位置的参考文献添加链接时，原代码无法正常更新下一处要添加超链接的位置，最关键的是其中pos变量。**为此，我增加了对同一位置参考文献的不同引用的定位代码，然后将定位结果复制给pos变量，让代码循环执行时可以正确找到应该添加参考文献的位置

对于第3个问题，有些人说是文献原始的标题有误，我照着这个思路对代码进行了调试，然而事情并不是这样，有的文章标题里面就是有一些特殊符号，比如'#'，':'。那么是否可能是这些特殊符号会带来bug？事实证明，会的。原代码的titleAnchor在生成短标题的时候就是用Replace把这些特殊符号以及空格全部用''代替，然后Add为Bibliography的BookMark。在Bibliography中可以有这些特殊符号，但是作为BookMark，就不能有这些特殊符号。原代码没有将'#'替换为''，因此增加一下就解决了。

修改后的代码如下：

vbscript 复制代码

Public Sub ZoteroLinkCitation()
Dim nStart&, nEnd&
nStart = Selection.Start
nEnd = Selection.End
Application.ScreenUpdating = False
Dim title As String
Dim titleAnchor As String
Dim style As String
Dim fieldCode As String
Dim numOrYear As String
Dim pos&, n1&, n2&

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
Selection.Find.Execute
With ActiveDocument.Bookmarks
    .Add Range:=Selection.Range, name:="Zotero_Bibliography"
    .DefaultSorting = wdSortByName
    .ShowHidden = True
End With
ActiveWindow.View.ShowFieldCodes = False


For Each aField In ActiveDocument.Fields
' check if the field is a Zotero in-text reference
    If InStr(aField.Code, "ADDIN ZOTERO_ITEM") > 0 Then
        fieldCode = aField.Code
        pos = 0
        Paper_i = 1
        Do While InStr(fieldCode, """title"":""") > 0
            n1 = InStr(fieldCode, """title"":""") + Len("""title"":""")
            n2 = InStr(Mid(fieldCode, n1, Len(fieldCode) - n1), """,""") - 1 + n1
        
            title = Mid(fieldCode, n1, n2 - n1)
            
            titleAnchor = Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(title, " ", "_"), "#", "_"), "&", "_"), ":", "_"), ",", "_"), "-", "_"), ".", "_"), "(", "_"), ")", "_"), "?", "_"), "!", "_")
            titleAnchor = Left(titleAnchor, 40)
            
            Selection.GoTo What:=wdGoToBookmark, name:="Zotero_Bibliography"
            Selection.Find.ClearFormatting
            With Selection.Find
                .Text = Left(title, 255)
                .Replacement.Text = ""
                .Forward = True
                .Wrap = wdFindAsk
                .Format = False
                .MatchCase = False
                .MatchWholeWord = False
                .MatchWildcards = False
                .MatchSoundsLike = False
                .MatchAllWordForms = False
            End With
            '查找引文，Bibliography
            Selection.Find.Execute
            '选中对应引文的这一段
            Selection.Paragraphs(1).Range.Select
            
            With ActiveDocument.Bookmarks
                .Add Range:=Selection.Range, name:=titleAnchor
                .DefaultSorting = wdSortByName
                .ShowHidden = True
            End With
            
            aField.Select
                        
            Selection.Find.ClearFormatting
                
            If pos = 0 Then
                ' 初始化起始位置和数组
                startPosition = 1
                ReDim commaPositions(1 To 1)
                    
                ' 查找逗号的位置(前提是作者和年份之间采用英文逗号分隔符，否则要改为其他符号)
                Do
                    commaPosition = InStr(startPosition, Selection, ",")
                    
                    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
            End If
                ' 输出记录的逗号位置
            'For j = 1 To UBound(commaPositions)
                'Debug.Print "Comma found at position: " & commaPositions(j)
            'Next j
                
            With Selection.Find
                .Text = "^#"
                .Replacement.Text = ""
                .Forward = True
                .Wrap = wdFindContinue
                .Format = False
                .MatchCase = False
                .MatchWholeWord = False
                .MatchWildcards = False
                .MatchSoundsLike = False
                .MatchAllWordForms = False
            End With
            
            Selection.Find.Execute
            
            Selection.MoveLeft Unit:=wdCharacter, Count:=1
            Selection.MoveRight Unit:=wdCharacter, Count:=pos
            
            Selection.Find.Execute
            Selection.MoveLeft Unit:=wdCharacter, Count:=1
            Selection.MoveRight Unit:=wdWord, Count:=1, Extend:=wdExtend
             
            numOrYear = Selection.Range.Text & ""
            
            pos = commaPositions(Paper_i) - 1
            Paper_i = Paper_i + 1
            
            style = Selection.style
                
            '插入超链接
            ActiveDocument.Hyperlinks.Add Anchor:=Selection.Range, Address:="", SubAddress:=titleAnchor, ScreenTip:="", TextToDisplay:="" & numOrYear
            aField.Select
            
            Selection.style = style
            '如果为文中的参考文献引用设定了格式，那么需要取消下面的注释
            'Selection.style = ActiveDocument.Styles("CitationFormating")
            
            fieldCode = Mid(fieldCode, n2 + 1, Len(fieldCode) - n2 - 1)
        
        Loop
    End If
Next aField
ActiveDocument.Range(nStart, nEnd).Select
End Sub