在word中使用zotero添加参考文献并附带超链接
一、引言
在写大论文时，为了避免文中引用与文末参考文献频繁对照、修改文中引用顺序/引用文献时手动维护参考文献耗易出错，拟在 word 中使用 zotero 插入参考文献，并为每个参考文献附加超链接，实现交互式阅读。
版本：word2016 + zotero7.0.15
二、配置zotero
这里我首先对 zotero 进行了一下更新，原本我是 6.0 版本，更新为 7.0 版本后发现好多东西 zotero 都已经自带了，不需要再自行下载配置。
1. 添加引用文献样式
下载链接
里面有非常多学校的模板，感谢各位大佬的分享。
下载好后，选择自己学校的模板，然后双击 cls 文件，即可添加至 zotero 参考文献样式库。
安装。
OK。
调用这个模板后没有出现中英文混杂等任何问题。
2. 配置宏实现超链接
参考链接1
参考链接2
- word 选项卡——>视图——>宏——>查看宏
- 创建一个名为 ZoteroLinkCitation 的宏
- 在编辑器中填入以下代码并保存
Public Sub ZoteroLinkCitation()
' get selected area (if applicable)
Dim nStart&, nEnd&
nStart = Selection.Start
nEnd = Selection.End
' toggle screen updating
Application.ScreenUpdating = False
' define variables
Dim title As String
Dim titleAnchor As String
Dim style As String
Dim fieldCode As String
Dim numOrYear As String
Dim pos&, n1&, n2&, n3&
ActiveWindow.View.ShowFieldCodes = True
Selection.Find.ClearFormatting
' find the Zotero bibliography
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
' add bookmark for the Zotero bibliography
With ActiveDocument.Bookmarks
.Add Range:=Selection.Range, Name:="Zotero_Bibliography"
.DefaultSorting = wdSortByName
.ShowHidden = True
End With
' loop through each field in the document
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
'#############
' Prepare
' Plain citation== Format of Textfield shown
' must be in Brackets
Dim plain_Cit As String
plCitStrBeg = """plainCitation"":""["
plCitStrEnd = "]"""
n1 = InStr(fieldCode, plCitStrBeg)
n1 = n1 + Len(plCitStrBeg)
n2 = InStr(Mid(fieldCode, n1, Len(fieldCode) - n1), plCitStrEnd) - 1 + n1
plain_Cit = Mid$(fieldCode, n1 - 1, n2 - n1 + 2)
'Reference 'as shown' in word as a string
'Title array in fieldCode (all referenced Titles within this field)
Dim array_RefTitle(32) As String
i = 0
Do While InStr(fieldCode, """title"":""") > 0
n1 = InStr(fieldCode, """title"":""") + Len("""title"":""")
n2 = InStr(Mid(fieldCode, n1, Len(fieldCode) - n1), """,""") - 1 + n1
If n2 < n1 Then 'Exception the type 'Article'
n2 = InStr(Mid(fieldCode, n1, Len(fieldCode) - n1), "}") - 1 + n1 - 1
End If
array_RefTitle(i) = Mid(fieldCode, n1, n2 - n1)
fieldCode = Mid(fieldCode, n2 + 1, Len(fieldCode) - n2 - 1)
i = i + 1
Loop
Titles_in_Cit = i
'Number array with References shown in PlainCit
'Numer is equal or less than Titels, depending on the type
'[3], [8]-[10]; [2]-[4]; [2], [4], [5]
' All citations have to be in Brackets each! [3], [8] not [3, 8]
' This doesnt work otherwise!
' --> treatment of other delimiters could be implemented here
Dim RefNumber(32) As String
i = 0
Do While (InStr(plain_Cit, "]") Or InStr(plain_Cit, "[")) > 0
n1 = InStr(plain_Cit, "[")
n2 = InStr(plain_Cit, "]")
RefNumber(i) = Mid(plain_Cit, n1 + 1, n2 - (n1 + 1))
plain_Cit = Mid(plain_Cit, n2 + 1, Len(plain_Cit) - (n2 + 1) + 1)
i = i + 1
Loop
Refs_in_Cit = i
'treat only the shown references (skip the rest)
'[3], [8]-[10] --> skip [9]
'Order of titles given from fieldcode, not checked!
If Titles_in_Cit > Refs_in_Cit Then
array_RefTitle(Refs_in_Cit - 1) = array_RefTitle(Titles_in_Cit - 1)
i = 1
Do While Refs_in_Cit + i <= Titles_in_Cit
array_RefTitle(Refs_in_Cit + i - 1) = ""
i = i + 1
Loop
End If
'#############
'Make the links
For Refs = 0 To Refs_in_Cit - 1 Step 1
title = array_RefTitle(Refs)
array_RefTitle(Refs) = ""
' make title a valid bookmark name
titleAnchor = title
titleAnchor = MakeValidBMName(titleAnchor)
ActiveWindow.View.ShowFieldCodes = False
Selection.GoTo What:=wdGoToBookmark, Name:="Zotero_Bibliography"
'' locate the corresponding reference in the bibliography
'' by searching for its title
Selection.Find.ClearFormatting
With Selection.Find
.Text = Left(title, 255)
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
' select the whole caption (for mouseover tooltip)
Selection.MoveStartUntil ("["), Count:=wdBackward
Selection.MoveEndUntil (vbBack)
lnkcap = "[" & Selection.Text
lnkcap = Left(lnkcap, 70)
' add bookmark for the reference within the bibliography
Selection.Shrink
With ActiveDocument.Bookmarks
.Add Range:=Selection.Range, Name:=titleAnchor
.DefaultSorting = wdSortByName
.ShowHidden = True
End With
' jump back to the field
aField.Select
' find and select the numeric part of the field which will become the hyperlink
Selection.Find.ClearFormatting
With Selection.Find
.Text = RefNumber(Refs)
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
numOrYear = Selection.Range.Text & ""
' store current style
style = Selection.style
' Generate the Hyperlink -->Forward!
ActiveDocument.Hyperlinks.Add Anchor:=Selection.Range, Address:="", SubAddress:=titleAnchor, ScreenTip:=lnkcap, TextToDisplay:="" & numOrYear
' reset the style
' comment if you want standard link style
aField.Select
With Selection.Font
.Underline = wdUnderlineNone
.ColorIndex = wdBlack
End With
Next Refs 'References in Cit
End If 'If Zotero-Field
'#########################
Next aField ' next field
' go back to original range selected
ActiveWindow.View.ShowFieldCodes = False
ActiveDocument.Range(nStart, nEnd).Select
End Sub
Function MakeValidBMName(strIn As String)
Dim pFirstChr As String
Dim i As Long
Dim tempStr As String
strIn = Trim(strIn)
pFirstChr = Left(strIn, 1)
If Not pFirstChr Like "[A-Za-z]" Then
strIn = "A_" & strIn
End If
For i = 1 To Len(strIn)
Select Case Asc(Mid$(strIn, i, 1))
Case 49 To 57, 65 To 90, 97 To 122
tempStr = tempStr & Mid$(strIn, i, 1)
Case Else
tempStr = tempStr & "_"
End Select
Next i
tempStr = Replace(tempStr, " ", " ")
MakeValidBMName = Left(tempStr, 40)
End Function
- 添加超链接
回到Word，切换到视图栏，然后打开宏窗口，找到刚刚创建好的宏，然后点击运行：
即可为每篇文献添加超链接。
三、问题
1. 新建宏
这里我首先用了 zotero 自带的 ZoteroLinkCitation 宏，运行后出现了如下问题：
然后我又新建了一个 ZoteroLinkCitation 宏，复制了 CSDN 上另外一个大佬分享的代码，但是运行时出现了如下错误：
搜索了一下好像是因为选中的文本中包含了换行符？我改了一下没有改好，然后又换成了上面那位大佬分享的代码，没有选择任何文本，直接运行之后没有错误，成功添加了超链接。
2. 在同一个位置引用多篇文献的方法
经典视图中点击“多重来源”，并且可以调整多个文献的相对顺序：
3.无法在同一个位置添加多个超链接
1. 问题描述
这里我使用新建宏添加了超链接后，出现了一个问题，即 1 个方括号只能为 1 篇参考文献添加超链接。具体来讲，就是当 1 个位置同时引用了多篇参考文献时，只能添加最后 1 篇参考文献的链接：
由于 zoero 实际上是通过书签的方式添加超链接的，因此我们先查看一下参考文献中是不是每篇都添加了书签。
word 选项卡——>文件——>选项——>高级——>显示书签
然后看到参考文献中的确有些文献没有附上书签，例如文献 2、4：
或者查看所有书签的名称：
宏代码中是使用文献名称作为书签名的，可以发现书签数量与文献数量并不相符。因此确实有些文献没有成功创建超链接。
2. 解决方案
来看一下这段 VBA 代码写了什么（不得不说有大模型太方便了，分分钟解释清楚代码在干嘛）：
' 声明一个公共子程序（宏）ZoteroLinkCitation
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&, n3& ' 存储位置索引
ActiveWindow.View.ShowFieldCodes = True ' 显示字段代码
Selection.Find.ClearFormatting ' 清除查找格式，确保查找操作不会受到之前格式设置的影响。
' 查找Zotero参考文献目录字段
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
' 遍历文档中的所有字段
For Each aField In ActiveDocument.Fields
' 检查是否是Zotero的引用字段
If InStr(aField.Code, "ADDIN ZOTERO_ITEM") > 0 Then
fieldCode = aField.Code ' 获取字段代码
'############# 准备阶段 #############
' 提取纯文本引用（例如[3]）
Dim plain_Cit As String
plCitStrBeg = """plainCitation"":""[" ' 定义引用开始标记
plCitStrEnd = """]""" ' 定义引用结束标记
n1 = InStr(fieldCode, plCitStrBeg) ' 查找开始位置
n1 = n1 + Len(plCitStrBeg)
n2 = InStr(Mid(fieldCode, n1, Len(fieldCode) - n1), plCitStrEnd) - 1 + n1
plain_Cit = Mid$(fieldCode, n1 - 1, n2 - n1 + 2) ' 提取引用内容
' 提取所有文献标题到数组
Dim array_RefTitle(32) As String ' 最多存储32个标题
i = 0
Do While InStr(fieldCode, """title"":""") > 0 ' 循环查找所有标题
n1 = InStr(fieldCode, """title"":""") + Len("""title"":""")
n2 = InStr(Mid(fieldCode, n1, Len(fieldCode) - n1), """,""") - 1 + n1
If n2 < n1 Then ' 处理特殊类型（如文章）
n2 = InStr(Mid(fieldCode, n1, Len(fieldCode) - n1), "}") - 1 + n1 - 1
End If
array_RefTitle(i) = Mid(fieldCode, n1, n2 - n1) ' 存储标题
fieldCode = Mid(fieldCode, n2 + 1, Len(fieldCode) - n2 - 1)
i = i + 1
Loop
Titles_in_Cit = i ' 记录找到的标题数量
' 提取引用编号（例如[3]中的3）
Dim RefNumber(32) As String
i = 0
Do While (InStr(plain_Cit, "]") Or InStr(plain_Cit, "[")) > 0
n1 = InStr(plain_Cit, "[")
n2 = InStr(plain_Cit, "]")
RefNumber(i) = Mid(plain_Cit, n1 + 1, n2 - (n1 + 1)) ' 提取编号
plain_Cit = Mid(plain_Cit, n2 + 1, Len(plain_Cit) - (n2 + 1) + 1)
i = i + 1
Loop
Refs_in_Cit = i ' 记录引用编号数量
' 处理标题与引用编号数量不一致的情况
If Titles_in_Cit > Refs_in_Cit Then
array_RefTitle(Refs_in_Cit - 1) = array_RefTitle(Titles_in_Cit - 1)
i = 1
Do While Refs_in_Cit + i <= Titles_in_Cit
array_RefTitle(Refs_in_Cit + i - 1) = ""
i = i + 1
Loop
End If
'############# 创建链接 #############
For Refs = 0 To Refs_in_Cit - 1 Step 1
title = array_RefTitle(Refs)
array_RefTitle(Refs) = ""
' 生成有效书签名（调用函数处理非法字符）
titleAnchor = MakeValidBMName(title)
' 跳转到参考文献书签位置
ActiveWindow.View.ShowFieldCodes = False
Selection.GoTo What:=wdGoToBookmark, Name:="Zotero_Bibliography"
' 在参考文献中查找对应标题
Selection.Find.ClearFormatting
With Selection.Find
.Text = Left(title, 255) ' 限制搜索长度
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
' 选择完整的引用条目
Selection.MoveStartUntil ("["), Count:=wdBackward
Selection.MoveEndUntil (vbBack)
lnkcap = "[" & Selection.Text ' 创建悬浮提示文本
lnkcap = Left(lnkcap, 70) ' 截断前70个字符
' 为文献条目添加书签
Selection.Shrink
With ActiveDocument.Bookmarks
.Add Range:=Selection.Range, Name:=titleAnchor
.DefaultSorting = wdSortByName
.ShowHidden = True
End With
' 返回原引用位置
aField.Select
' 查找引用编号所在位置
Selection.Find.ClearFormatting
With Selection.Find
.Text = RefNumber(Refs)
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
numOrYear = Selection.Range.Text & "" ' 获取显示的编号
' 创建超链接
ActiveDocument.Hyperlinks.Add _
Anchor:=Selection.Range, _
Address:="", _
SubAddress:=titleAnchor, _
ScreenTip:=lnkcap, _
TextToDisplay:="" & numOrYear
' 重置字体样式（取消下划线）
aField.Select
With Selection.Font
.Underline = wdUnderlineNone
.ColorIndex = wdBlack
End With
Next Refs ' 处理下一个引用
End If ' 结束Zotero字段判断
Next aField ' 处理下一个字段
' 恢复原始视图和选区
ActiveWindow.View.ShowFieldCodes = False
ActiveDocument.Range(nStart, nEnd).Select
End Sub
' 辅助函数：生成有效书签名（移除非法字符）
Function MakeValidBMName(strIn As String)
Dim pFirstChr As String
Dim i As Long
Dim tempStr As String
strIn = Trim(strIn)
pFirstChr = Left(strIn, 1)
If Not pFirstChr Like "[A-Za-z]" Then ' 首字符非字母时加前缀
strIn = "A_" & strIn
End If
For i = 1 To Len(strIn)
Select Case Asc(Mid$(strIn, i, 1)) ' 只保留字母数字
Case 49 To 57, 65 To 90, 97 To 122 ' 允许1-9, A-Z, a-z
tempStr = tempStr & Mid$(strIn, i, 1)
Case Else
tempStr = tempStr & "_" ' 替换其他字符为下划线
End Select
Next i
tempStr = Replace(tempStr, " ", " ") ' 替换双空格
MakeValidBMName = Left(tempStr, 40) ' 截断为前40字符
End Function
1）参考文献以逗号形式隔开
参考链接
当遇到引用形式类似 [2, 3] 这种情况时，在执行完下面这段代码后：
'Title array in fieldCode (all referenced Titles within this field) fieldCode中的标题数组（此字段中引用的所有标题）
Dim array_RefTitle(32) As String
i = 0
Do While InStr(fieldCode, """title"":""") > 0
n1 = InStr(fieldCode, """title"":""") + Len("""title"":""")
n2 = InStr(Mid(fieldCode, n1, Len(fieldCode) - n1), """,""") - 1 + n1
If n2 < n1 Then 'Exception the type 'Article'
n2 = InStr(Mid(fieldCode, n1, Len(fieldCode) - n1), "}") - 1 + n1 - 1
End If
array_RefTitle(i) = Mid(fieldCode, n1, n2 - n1)
fieldCode = Mid(fieldCode, n2 + 1, Len(fieldCode) - n2 - 1)
i = i + 1
Loop
可以看到 array_RefTitle 确实存入了文献 2 和文献 3 的标题：
在执行完下面这段代码后，RefNumber 变为了 ‘2， 3’， Refs_in_Cit 变为了 1：
'Number array with References shown in PlainCit 'PlainCit中显示了引用的数字数组
'Numer is equal or less than Titels, depending on the type 'Numer等于或小于Titels，具体取决于类型
'[3], [8]-[10]; [2]-[4]; [2], [4], [5] '[3], [8]-[10]; [2]-[4]; [2], [4], [5]
' All citations have to be in Brackets each! [3], [8] not [3, 8] 所有引文都必须用括号括起来！[3] [8]不是[3,8]
' This doesnt work otherwise! 否则，这行不通！
' --> treatment of other delimiters could be implemented here
Dim RefNumber(32) As String
i = 0
Do While (InStr(plain_Cit, "]") Or InStr(plain_Cit, "[")) > 0
n1 = InStr(plain_Cit, "[")
n2 = InStr(plain_Cit, "]")
RefNumber(i) = Mid(plain_Cit, n1 + 1, n2 - (n1 + 1))
plain_Cit = Mid(plain_Cit, n2 + 1, Len(plain_Cit) - (n2 + 1) + 1)
i = i + 1
Loop
Refs_in_Cit = i
在执行完下面这段代码后，array_RefTitle 就只剩下了文献 3 的标题：
'treat only the shown references (skip the rest) 仅处理显示的引用（跳过其余部分）
'[3], [8]-[10] --> skip [9] [3] ，[8]-[10]-->跳过[9]
'Order of titles given from fieldcode, not checked! 从字段代码给出的标题顺序，未选中！
If Titles_in_Cit > Refs_in_Cit Then
array_RefTitle(Refs_in_Cit - 1) = array_RefTitle(Titles_in_Cit - 1)
i = 1
Do While Refs_in_Cit + i <= Titles_in_Cit
array_RefTitle(Refs_in_Cit + i - 1) = ""
i = i + 1
Loop
在执行到下面这段代码时：
' find and select the numeric part of the field which will become the hyperlink 查找并选择将成为超链接的字段的数字部分
Selection.Find.ClearFormatting
With Selection.Find
.Text = RefNumber(Refs)
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
numOrYear = Selection.Range.Text & ""
' store current style
style = Selection.style
' Generate the Hyperlink -->Forward!
ActiveDocument.Hyperlinks.Add Anchor:=Selection.Range, Address:="", SubAddress:=titleAnchor, ScreenTip:=lnkcap, TextToDisplay:="" & numOrYear
可以看到，插入超链接的文本就是 RefNumber，这里即为 ‘2, 3’。
看到这里问题已经很明白了。现在的代码是为每个方括号添加了超链接，且只能添加最后 1 篇文献的超链接。而我们需要的实际上是为每个引文编号添加超链接。
因此，我们只需要将插入超链接的文本由每个方括号的内容改为每个引用编号即可。将 RefNumber 部分的代码改为如下形式：
'Number array with References shown in PlainCit 'PlainCit中显示了引用的数字数组
'Numer is equal or less than Titels, depending on the type 'Numer等于或小于Titels，具体取决于类型
'[3], [8]-[10]; [2]-[4]; [2], [4], [5] '[3], [8]-[10]; [2]-[4]; [2], [4], [5]
' All citations have to be in Brackets each! [3], [8] not [3, 8] 所有引文都必须用括号括起来！[3] [8]不是[3,8]
' This doesnt work otherwise! 否则，这行不通！
' --> treatment of other delimiters could be implemented here
Dim RefNumber(32) As String
i = 0
' 初始化起始位置和数组
startPosition = InStr(plain_Cit, "[")
commaPosition = 0
ReDim commaPositions(0 To 0)
Do While (InStr(plain_Cit, "]") Or InStr(plain_Cit, "[")) > 0
' 查找逗号的位置
commaPosition = InStr(plain_Cit, ",") ' 这里查找的是第一个逗号的位置
If commaPosition = 0 Then ' 引文数量 = 1
commaPosition = InStr(plain_Cit, "]")
RefNumber(i) = Mid(plain_Cit, startPosition + 1, commaPosition - (startPosition + 1))
plain_Cit = Mid(plain_Cit, commaPosition + 1, Len(plain_Cit) - (commaPosition + 1) + 1)
Else ' 引文数量 > 1
RefNumber(i) = Mid(plain_Cit, startPosition + 1, commaPosition - (startPosition + 1))
plain_Cit = Mid(plain_Cit, commaPosition + 2, Len(plain_Cit) - (commaPosition + 2))
' 检查是否为空字符串
If Len(Trim(plain_Cit)) = 0 Then
plain_Cit = plain_Cit
Else
plain_Cit = "[" & plain_Cit & "]"
End If
End If
i = i + 1
Loop
Refs_in_Cit = i
以逗号为分隔，为每个引用编号添加超链接。这里由于我使用的引用文献样式中每个逗号后面都会有一个空格，所以提取字符串部分使用的是 commaPosition + 2，若没有空格则应该改为 commaPosition + 1。
运行后发现 4、5 分别引用成功了：
可以看到参考文献部分添加的书签也明显多了，例如2、4，都成功添加了书签：
2）参考文献以短横线连接
除了形如 [2, 3] 类的引用形式外，还存在 [6-8] 这类的形式。显然，这种形式的引用也只能添加最后 1 篇参考文献的链接：
以上如为例，我们需要的是为文献 2、6、8 分别添加超链接，这里 2 添加成功了，但是 6-8 只添加了文献 8 的链接。因此我们只需要再查找一下 “-” 的位置即可。
将 RefNumber 部分的代码改为如下形式：
'Number array with References shown in PlainCit 'PlainCit中显示了引用的数字数组
'Numer is equal or less than Titels, depending on the type 'Numer等于或小于Titels，具体取决于类型
'[3], [8]-[10]; [2]-[4]; [2], [4], [5] '[3], [8]-[10]; [2]-[4]; [2], [4], [5]
' All citations have to be in Brackets each! [3], [8] not [3, 8] 所有引文都必须用括号括起来！[3] [8]不是[3,8]
' This doesnt work otherwise! 否则，这行不通！
' --> treatment of other delimiters could be implemented here
Dim RefNumber(32) As String
i = 0
' 初始化起始位置和数组
startPosition = InStr(plain_Cit, "[")
commaPosition = 0 ' 初始化逗号位置
dashPosition = 0 ' 初始化短横线位置
ReDim commaPositions(0 To 0)
Do While (InStr(plain_Cit, "]") Or InStr(plain_Cit, "[")) > 0
' 查找逗号的位置
commaPosition = InStr(plain_Cit, ",") ' 这里查找的是第一个逗号的位置
' 查找短横线的位置
dashPosition = InStr(plain_Cit, "-") ' 这里查找的是第一个短横线的位置
If commaPosition = 0 And dashPosition = 0 Then ' 情况0：都不存在
commaPosition = InStr(plain_Cit, "]")
RefNumber(i) = Mid(plain_Cit, startPosition + 1, commaPosition - (startPosition + 1))
plain_Cit = Mid(plain_Cit, commaPosition + 1, Len(plain_Cit) - (commaPosition + 1) + 1)
ElseIf commaPosition > 0 And dashPosition > 0 Then ' 情况1/2：两者都存在
If commaPosition < dashPosition Then ' 逗号在前
RefNumber(i) = Mid(plain_Cit, startPosition + 1, commaPosition - (startPosition + 1))
plain_Cit = Mid(plain_Cit, commaPosition + 2, Len(plain_Cit) - (commaPosition + 2))
' 检查是否为空字符串
If Len(Trim(plain_Cit)) = 0 Then
plain_Cit = plain_Cit
Else
plain_Cit = "[" & plain_Cit & "]"
End If
Else ' 短横线在前
RefNumber(i) = Mid(plain_Cit, startPosition + 1, dashPosition - (startPosition + 1))
plain_Cit = Mid(plain_Cit, dashPosition + 1, Len(plain_Cit) - (dashPosition + 1))
' 检查是否为空字符串
If Len(Trim(plain_Cit)) = 0 Then
plain_Cit = plain_Cit
Else
plain_Cit = "[" & plain_Cit & "]"
End If
End If
ElseIf commaPosition > 0 Then ' 情况3：只有逗号
RefNumber(i) = Mid(plain_Cit, startPosition + 1, commaPosition - (startPosition + 1))
plain_Cit = Mid(plain_Cit, commaPosition + 2, Len(plain_Cit) - (commaPosition + 2))
' 检查是否为空字符串
If Len(Trim(plain_Cit)) = 0 Then
plain_Cit = plain_Cit
Else
plain_Cit = "[" & plain_Cit & "]"
End If
Else ' 情况4：只有短横线
RefNumber(i) = Mid(plain_Cit, startPosition + 1, dashPosition - (startPosition + 1))
plain_Cit = Mid(plain_Cit, dashPosition + 1, Len(plain_Cit) - (dashPosition + 1))
' 检查是否为空字符串
If Len(Trim(plain_Cit)) = 0 Then
plain_Cit = plain_Cit
Else
plain_Cit = "[" & plain_Cit & "]"
End If
End If
i = i + 1
Loop
Refs_in_Cit = i
运行结束后可以分别为每个引用编号添加超链接：
再次查看参考文献部分，每篇论文都成功添加了书签，所有论文都被成功引用了。
修改后完整的代码如下：
Public Sub ZoteroLinkCitation()
' get selected area (if applicable)获取选定区域（如果适用）
Dim nStart&, nEnd&
nStart = Selection.Start
nEnd = Selection.End
' toggle screen updating 切换屏幕更新
Application.ScreenUpdating = False
' define variables 定义变量
Dim title As String
Dim titleAnchor As String
Dim style As String
Dim fieldCode As String
Dim numOrYear As String
Dim pos&, n1&, n2&, n3&
ActiveWindow.View.ShowFieldCodes = True
Selection.Find.ClearFormatting
' find the Zotero bibliography 查找Zotero参考目录
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
' add bookmark for the Zotero bibliography 为Zotero参考目录添加书签
With ActiveDocument.Bookmarks
.Add Range:=Selection.Range, Name:="Zotero_Bibliography"
.DefaultSorting = wdSortByName
.ShowHidden = True
End With
' loop through each field in the document 遍历文档中的每个字段
For Each aField In ActiveDocument.Fields
' check if the field is a Zotero in-text reference 检查文本引用中的字段是否为Zotero
'##################################################
If InStr(aField.Code, "ADDIN ZOTERO_ITEM") > 0 Then
fieldCode = aField.Code
'#############
' Prepare
' Plain citation== Format of Textfield shown 纯文本引用
' must be in Brackets 必须放在方括号中
Dim plain_Cit As String
plCitStrBeg = """plainCitation"":""["
plCitStrEnd = "]"""
n1 = InStr(fieldCode, plCitStrBeg)
n1 = n1 + Len(plCitStrBeg)
n2 = InStr(Mid(fieldCode, n1, Len(fieldCode) - n1), plCitStrEnd) - 1 + n1
plain_Cit = Mid$(fieldCode, n1 - 1, n2 - n1 + 2)
'Reference 'as shown' in word as a string
'Title array in fieldCode (all referenced Titles within this field) fieldCode中的标题数组（此字段中引用的所有标题）
Dim array_RefTitle(32) As String
i = 0
Do While InStr(fieldCode, """title"":""") > 0
n1 = InStr(fieldCode, """title"":""") + Len("""title"":""")
n2 = InStr(Mid(fieldCode, n1, Len(fieldCode) - n1), """,""") - 1 + n1
If n2 < n1 Then 'Exception the type 'Article'
n2 = InStr(Mid(fieldCode, n1, Len(fieldCode) - n1), "}") - 1 + n1 - 1
End If
array_RefTitle(i) = Mid(fieldCode, n1, n2 - n1)
fieldCode = Mid(fieldCode, n2 + 1, Len(fieldCode) - n2 - 1)
i = i + 1
Loop
Titles_in_Cit = i
'Number array with References shown in PlainCit 'PlainCit中显示了引用的数字数组
'Numer is equal or less than Titels, depending on the type 'Numer等于或小于Titels，具体取决于类型
'[3], [8]-[10]; [2]-[4]; [2], [4], [5] '[3], [8]-[10]; [2]-[4]; [2], [4], [5]
' All citations have to be in Brackets each! [3], [8] not [3, 8] 所有引文都必须用括号括起来！[3] [8]不是[3,8]
' This doesnt work otherwise! 否则，这行不通！
' --> treatment of other delimiters could be implemented here
Dim RefNumber(32) As String
i = 0
' 初始化起始位置和数组
startPosition = InStr(plain_Cit, "[")
commaPosition = 0 ' 初始化逗号位置
dashPosition = 0 ' 初始化短横线位置
ReDim commaPositions(0 To 0)
Do While (InStr(plain_Cit, "]") Or InStr(plain_Cit, "[")) > 0
' 查找逗号的位置
commaPosition = InStr(plain_Cit, ",") ' 这里查找的是第一个逗号的位置
' 查找短横线的位置
dashPosition = InStr(plain_Cit, "-") ' 这里查找的是第一个短横线的位置
If commaPosition = 0 And dashPosition = 0 Then ' 情况0：都不存在
commaPosition = InStr(plain_Cit, "]")
RefNumber(i) = Mid(plain_Cit, startPosition + 1, commaPosition - (startPosition + 1))
plain_Cit = Mid(plain_Cit, commaPosition + 1, Len(plain_Cit) - (commaPosition + 1) + 1)
ElseIf commaPosition > 0 And dashPosition > 0 Then ' 情况1/2：两者都存在
If commaPosition < dashPosition Then ' 逗号在前
RefNumber(i) = Mid(plain_Cit, startPosition + 1, commaPosition - (startPosition + 1))
plain_Cit = Mid(plain_Cit, commaPosition + 2, Len(plain_Cit) - (commaPosition + 2))
' 检查是否为空字符串
If Len(Trim(plain_Cit)) = 0 Then
plain_Cit = plain_Cit
Else
plain_Cit = "[" & plain_Cit & "]"
End If
Else ' 短横线在前
RefNumber(i) = Mid(plain_Cit, startPosition + 1, dashPosition - (startPosition + 1))
plain_Cit = Mid(plain_Cit, dashPosition + 1, Len(plain_Cit) - (dashPosition + 1))
' 检查是否为空字符串
If Len(Trim(plain_Cit)) = 0 Then
plain_Cit = plain_Cit
Else
plain_Cit = "[" & plain_Cit & "]"
End If
End If
ElseIf commaPosition > 0 Then ' 情况3：只有逗号
RefNumber(i) = Mid(plain_Cit, startPosition + 1, commaPosition - (startPosition + 1))
plain_Cit = Mid(plain_Cit, commaPosition + 2, Len(plain_Cit) - (commaPosition + 2))
' 检查是否为空字符串
If Len(Trim(plain_Cit)) = 0 Then
plain_Cit = plain_Cit
Else
plain_Cit = "[" & plain_Cit & "]"
End If
Else ' 情况4：只有短横线
RefNumber(i) = Mid(plain_Cit, startPosition + 1, dashPosition - (startPosition + 1))
plain_Cit = Mid(plain_Cit, dashPosition + 1, Len(plain_Cit) - (dashPosition + 1))
' 检查是否为空字符串
If Len(Trim(plain_Cit)) = 0 Then
plain_Cit = plain_Cit
Else
plain_Cit = "[" & plain_Cit & "]"
End If
End If
i = i + 1
Loop
Refs_in_Cit = i
'treat only the shown references (skip the rest) 仅处理显示的引用（跳过其余部分）
'[3], [8]-[10] --> skip [9] [3] ，[8]-[10]-->跳过[9]
'Order of titles given from fieldcode, not checked! 从字段代码给出的标题顺序，未选中！
If Titles_in_Cit > Refs_in_Cit Then
array_RefTitle(Refs_in_Cit - 1) = array_RefTitle(Titles_in_Cit - 1)
i = 1
Do While Refs_in_Cit + i <= Titles_in_Cit
array_RefTitle(Refs_in_Cit + i - 1) = ""
i = i + 1
Loop
End If
'#############
'Make the links
For Refs = 0 To Refs_in_Cit - 1 Step 1
title = array_RefTitle(Refs)
array_RefTitle(Refs) = ""
' make title a valid bookmark name
titleAnchor = title
titleAnchor = MakeValidBMName(titleAnchor)
ActiveWindow.View.ShowFieldCodes = False
Selection.GoTo What:=wdGoToBookmark, Name:="Zotero_Bibliography"
'' locate the corresponding reference in the bibliography
'' by searching for its title
Selection.Find.ClearFormatting
With Selection.Find
.Text = Left(title, 255)
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
' select the whole caption (for mouseover tooltip) 选择整个标题（用于鼠标悬停工具提示）
Selection.MoveStartUntil ("["), Count:=wdBackward
Selection.MoveEndUntil (vbBack)
lnkcap = "[" & Selection.Text
lnkcap = Left(lnkcap, 70)
' add bookmark for the reference within the bibliography 为参考目录中的参考添加书签
Selection.Shrink
With ActiveDocument.Bookmarks
.Add Range:=Selection.Range, Name:=titleAnchor
.DefaultSorting = wdSortByName
.ShowHidden = True
End With
' jump back to the field
aField.Select
' find and select the numeric part of the field which will become the hyperlink 查找并选择将成为超链接的字段的数字部分
Selection.Find.ClearFormatting
With Selection.Find
.Text = RefNumber(Refs)
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
numOrYear = Selection.Range.Text & ""
' store current style
style = Selection.style
' Generate the Hyperlink -->Forward!
ActiveDocument.Hyperlinks.Add Anchor:=Selection.Range, Address:="", SubAddress:=titleAnchor, ScreenTip:=lnkcap, TextToDisplay:="" & numOrYear
' reset the style
' comment if you want standard link style
aField.Select
With Selection.Font
.Underline = wdUnderlineNone
.ColorIndex = wdBlack
End With
Next Refs 'References in Cit
End If 'If Zotero-Field
'#########################
Next aField ' next field
' go back to original range selected
ActiveWindow.View.ShowFieldCodes = False
ActiveDocument.Range(nStart, nEnd).Select
End Sub
Function MakeValidBMName(strIn As String)
Dim pFirstChr As String
Dim i As Long
Dim tempStr As String
strIn = Trim(strIn)
pFirstChr = Left(strIn, 1)
If Not pFirstChr Like "[A-Za-z]" Then
strIn = "A_" & strIn
End If
For i = 1 To Len(strIn)
Select Case Asc(Mid$(strIn, i, 1))
Case 49 To 57, 65 To 90, 97 To 122
tempStr = tempStr & Mid$(strIn, i, 1)
Case Else
tempStr = tempStr & "_"
End Select
Next i
tempStr = Replace(tempStr, " ", " ")
MakeValidBMName = Left(tempStr, 40)
End Function