.

iT邦幫忙

0

在word中插入zotero文獻後,使用VBA自動超連結引用編號

  • 分享至 

  • xImage
  •  

參考文獻
https://blog.csdn.net/weixin_42413559/article/details/134494771
https://forums.zotero.org/discussion/comment/148343/#Comment_148343
https://blog.csdn.net/weixin_47244593/article/details/129072589

寫論文的時候使用zotero來管理文獻,最後整理階段時,想要讓文章中每一個文獻都可以超連結跳轉到最下方的Reference,網上搜尋了許多方法,大多都是用VBA來處理,但是針對我的引用文獻實際運行起來還是有一些卡卡和RunTime Error。
本身跟VBA函示和語法不是很熟悉,算還看得懂但是不知道有那些FUNC可以使用,所幸就認真理解一下別人提供的程式碼,在此基礎上進行修改,並修正我遇到的問題。

程式碼主要流程:
1.在文件下方尋找Zotero Reference,並用vba加上word書籤
2.遍尋文章中所有引用部分,插入超連結到對應的書籤
https://ithelp.ithome.com.tw/upload/images/20241213/20106220Kaff11ULRQ.png =x300

我遇到的問題
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

https://ithelp.ithome.com.tw/upload/images/20241213/20106220jQr2kuVJ7o.png

問題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

程式碼中有些簡體中文的編碼錯誤就不處理了,還是建議大家先去看一下參考文章
參考文章裡面的圖文教學比較完整,對程式碼不熟悉的讀者也建議多看一下


.
圖片
  直播研討會

尚未有邦友留言

立即登入留言