企石镇做网站最佳的搜索引擎

Zotero 超链接

找了好多原代码，最接近能实施的为：
https://blog.csdn.net/weixin_47244593/article/details/129072589
但是，就是向他说的一样会报错，我修改了代码，遇见报错的地方会直接跳过不执行，事后找出自己再单独添加较为特殊文章即可，代码如下：

Public Sub ZoteroLinkCitation()On Error Resume Next ' Add this line to enable error handlingDim nStart&, nEnd&nStart = Selection.StartnEnd = Selection.EndApplication.ScreenUpdating = FalseDim title As StringDim titleAnchor As StringDim style As StringDim fieldCode As StringDim numOrYear As StringDim pos&, n1&, n2&ActiveWindow.View.ShowFieldCodes = TrueSelection.Find.ClearFormattingWith Selection.Find.Text = "^d ADDIN ZOTERO_BIBL".Replacement.Text = "".Forward = True.Wrap = wdFindContinue.Format = False.MatchCase = False.MatchWholeWord = False.MatchWildcards = False.MatchSoundsLike = False.MatchAllWordForms = FalseEnd WithSelection.Find.ExecuteWith ActiveDocument.Bookmarks.Add Range:=Selection.Range, Name:="Zotero_Bibliography".DefaultSorting = wdSortByName.ShowHidden = TrueEnd WithActiveWindow.View.ShowFieldCodes = FalseFor Each aField In ActiveDocument.Fields' check if the field is a Zotero in-text referenceIf InStr(aField.Code, "ADDIN ZOTERO_ITEM") > 0 ThenfieldCode = aField.Codepos = 0Do While InStr(fieldCode, """title"":""") > 0n1 = InStr(fieldCode, """title"":""") + Len("""title"":""")n2 = InStr(Mid(fieldCode, n1, Len(fieldCode) - n1), """,""") - 1 + n1title = Mid(fieldCode, n1, n2 - n1)titleAnchor = Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(title, " ", "_"), "&", "_"), ":", "_"), ",", "_"), "-", "_"), ".", "_"), "(", "_"), ")", "_"), "?", "_"), "!", "_")titleAnchor = Left(titleAnchor, 40)Selection.GoTo What:=wdGoToBookmark, Name:="Zotero_Bibliography"Selection.Find.ClearFormattingWith Selection.Find.Text = Left(title, 255).Replacement.Text = "".Forward = True.Wrap = wdFindAsk.Format = False.MatchCase = False.MatchWholeWord = False.MatchWildcards = False.MatchSoundsLike = False.MatchAllWordForms = FalseEnd WithSelection.Find.ExecuteSelection.Paragraphs(1).Range.SelectWith ActiveDocument.Bookmarks.Add Range:=Selection.Range, Name:=titleAnchor.DefaultSorting = wdSortByName.ShowHidden = TrueEnd WithaField.SelectSelection.Find.ClearFormattingWith Selection.Find.Text = "^#".Replacement.Text = "".Forward = True.Wrap = wdFindContinue.Format = False.MatchCase = False.MatchWholeWord = False.MatchWildcards = False.MatchSoundsLike = False.MatchAllWordForms = FalseEnd WithSelection.Find.ExecuteSelection.MoveLeft Unit:=wdCharacter, Count:=1Selection.MoveRight Unit:=wdCharacter, Count:=posSelection.Find.ExecuteSelection.MoveLeft Unit:=wdCharacter, Count:=1Selection.MoveRight Unit:=wdWord, Count:=1, Extend:=wdExtendnumOrYear = Selection.Range.Text & ""pos = Len(numOrYear)style = Selection.styleActiveDocument.Hyperlinks.Add Anchor:=Selection.Range, Address:="", SubAddress:=titleAnchor, ScreenTip:="", TextToDisplay:="" & numOrYearaField.SelectSelection.style = style'Selection.style = ActiveDocument.Styles("CitationFormating")fieldCode = Mid(fieldCode, n2 + 1, Len(fieldCode) - n2 - 1)LoopEnd IfNext aFieldActiveDocument.Range(nStart, nEnd).Select
End Sub

超链接颜色变化

在这里也给出全盘改变超链接颜色的代码：
参考链接如下：https://zhuanlan.zhihu.com/p/680291144

Sub CitingColor()For i = 1 To ActiveDocument.Fields.Count '遍历文档所有域' Word 自带的交叉引用的域代码起始 4 位是 " REF" (注意空格)' Endnote 插入的引用域代码的起始 14 位是 " ADDIN EN.CITE"' Zotero 插入的引用域代码的起始 31 位是 " ADDIN ZOTERO_ITEM CSL_CITATION"，可根据需求添加其他类型If Left(ActiveDocument.Fields(i).Code, 4) = " REF" Or Left(ActiveDocument.Fields(i).Code, 14) = " ADDIN EN.CITE" Or Left(ActiveDocument.Fields(i).Code, 31) = " ADDIN ZOTERO_ITEM CSL_CITATION" ThenActiveDocument.Fields(i).Select ' 选中上述几类域Selection.Font.Color = wdColorBlue ' 设置字体颜色为蓝色，可改为其他颜色，如 RGB(255,0,0)End IfNext
End Sub

给doi插入超链接

参考链接

Sub AddHyperlinksToDOIs()Dim doc As DocumentDim rng As RangeDim field As fieldDim doi As StringDim test As StringSet doc = ActiveDocumentSet rng = doc.RangeWith rng.Find.ClearFormatting.Text = "doi:*^13".MatchWildcards = True.Wrap = wdFindStop.Forward = TrueDo While .Executerng.MoveEnd wdCharacter, -1doi = rng.Textdoi = Mid(doi, 6, Len(doi) - 6)rng.Hyperlinks.Add Anchor:=rng, Address:="https://doi.org/" & doi' 移动到下一个匹配项rng.Collapse wdCollapseEndrng.MoveStart wdCharacter, 1LoopEnd With
End Sub