在word中插入zotero文献后，使用VBA自动超连结引用编号

参考文献https://blog.csdn.net/weixin_42413559/article/details/134494771https://forums.zotero.org/discussion/comment/148343/#Comment_148343https://blog.csdn.net/weixin_47244593/article/details/129072589

写论文的时候使用zotero来管理文献，最后整理阶段时，想要让文章中每一个文献都可以超连结跳转到最下方的Reference，网上搜寻了许多方法，大多都是用VBA来处理，但是针对我的引用文献实际运行起来还是有一些卡卡和RunTime Error。本身跟VBA函示和语法不是很熟悉，算还看得懂但是不知道有那些FUNC可以使用，所幸就认真理解一下别人提供的程式码，在此基础上进行修改，并修正我遇到的问题。

程式码主要流程：1.在文件下方寻找Zotero Reference，并用vba加上word书籤2.遍寻文章中所有引用部分，插入超连结到对应的书籤

我遇到的问题1.建立书籤时，如果titleAnchor中的string含有"[]",或是第一个字元是数字，就会建立失败(可以手动尝试，选择一段文字-插入-书籤-输入自定义的书籤名称)2.在连续引用多个REF时，只针对连续引用[2][3][4]处理，遇到其他REF风格如:[2]-[4]的时候也会坏掉。

因小弟无心钻研VBA语法，定位完问题后，直接请GPT帮忙修正程式逻辑如下:问题1:在前人基础上123，针对变数titleAnchor做处理，在原本titleAnchor前面加上R1,R2,R3...作为书籤名称，以后手动link的时候也会比较方便查找。

With ActiveDocument.Bookmarks
\' Assume the correctly parsed number in brackets is in the format "[4]" or similar at the start of citation
Dim extractedNumber As String
Dim openingBracketPos As Long
Dim closingBracketPos As Long

\' Find the position of brackets, you might need to adjust logic if citation format varies
openingBracketPos = InStr(Selection.Range.Text, "[")
closingBracketPos = InStr(Selection.Range.Text, "]")

\' Check if both brackets are found
If openingBracketPos > 0 And closingBracketPos > openingBracketPos Then
extractedNumber = Mid(Selection.Range.Text, openingBracketPos + 1, closingBracketPos - openingBracketPos - 1)

\' Construct the citation number with \'R\' prefix
citationNumber = "R" & extractedNumber
titleAnchor = citationNumber & "_" & titleAnchor

.Add Range:=Selection.Range, Name:=titleAnchor
.DefaultSorting = wdSortByName
.ShowHidden = True
End With

问题2:commaPositions(Paper_i)这个函式会溢位，所幸就直接判断溢位的时候跳出迴圈不要抱错即可。既然书籤已经建立成功，之后再回去文章中多篇引用的部分，手动设定超连结色

If Paper_i > UBound(commaPositions) Then
Exit Do \' 跳出循环，避免超出范围
End If
pos = commaPositions(Paper_i) - 1

完整的VBA程式码如下

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(Replace(Replace(title, " ", "_"), "#", "_"), "&", "_"), ":", "_"), ",", "_"), "-", "_"), "?", "_"), "\'", "_"), ".", "_"), "(", "_"), ")", "_"), "?", "_"), "!", "_")
titleAnchor = Left(titleAnchor, 35)

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
\' 开头不能为数字，也不能有夸号
\' Assume the correctly parsed number in brackets is in the format "[4]" or similar at the start of citation
Dim extractedNumber As String
Dim openingBracketPos As Long
Dim closingBracketPos As Long

\' Find the position of brackets, you might need to adjust logic if citation format varies
openingBracketPos = InStr(Selection.Range.Text, "[")
closingBracketPos = InStr(Selection.Range.Text, "]")

\' Check if both brackets are found
If openingBracketPos > 0 And closingBracketPos > openingBracketPos Then
extractedNumber = Mid(Selection.Range.Text, openingBracketPos + 1, closingBracketPos - openingBracketPos - 1)
End If

\' Construct the citation number with \'R\' prefix
citationNumber = "R" & extractedNumber
titleAnchor = citationNumber & "_" & titleAnchor

.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 & ""

\' 确保 Paper_i 不超出 commaPositions 的范围
If Paper_i > UBound(commaPositions) Then
Exit Do \' 跳出循环，避免超出范围
End If
pos = commaPositions(Paper_i) - 1
Paper_i = Paper_i + 1

style = Selection.style
\'如果?文中的?考文?引用?定了格式，那么需要取消下面的注?
\'Selection.style = ActiveDocument.Styles("CitationFormating")

\'插入超?接
ActiveDocument.Hyperlinks.Add Anchor:=Selection.Range, Address:="", SubAddress:=titleAnchor, ScreenTip:="", TextToDisplay:="" & numOrYear
aField.Select

\'Selection.style = style

fieldCode = Mid(fieldCode, n2 + 1, Len(fieldCode) - n2 - 1)

Loop
End If
Next aField
ActiveDocument.Range(nStart, nEnd).Select
End Sub

程式码中有些简体中文的编码错误就不处理了，还是建议大家先去看一下参考文章参考文章里面的图文教学比较完整，对程式码不熟悉的读者也建议多看一下