Movatterモバイル変換


[0]ホーム

URL:


Skip to content
Search Gists
Sign in Sign up

Instantly share code, notes, and snippets.

@sxlllslgh
CreatedNovember 26, 2021 03:01
    • Star(0)You must be signed in to star a gist
    • Fork(0)You must be signed in to fork a gist
    Save sxlllslgh/8f18275b8de394e5ab149e6b5e4f2483 to your computer and use it in GitHub Desktop.
    Add bibliography link to citation in Zotero.
    PublicSubZoteroLinkCitation()
    ' get selected area (if applicable)
    DimnStart&,nEnd&
    nStart=Selection.Start
    nEnd=Selection.End
    ' toggle screen updating
    Application.ScreenUpdating=False
    ' define variables
    DimtitleAsString
    DimtitleAnchorAsString
    DimstyleAsString
    DimfieldCodeAsString
    DimnumOrYearAsString
    Dimpos&,n1&,n2&,n3&
    ActiveWindow.View.ShowFieldCodes=True
    Selection.Find.ClearFormatting
    ' find the Zotero bibliography
    WithSelection.Find
    .Text="^d ADDIN ZOTERO_BIBL"
    .Replacement.Text=""
    .Forward=True
    .Wrap=wdFindContinue
    .Format=False
    .MatchCase=False
    .MatchWholeWord=False
    .MatchWildcards=False
    .MatchSoundsLike=False
    .MatchAllWordForms=False
    EndWith
    Selection.Find.Execute
    ' add bookmark for the Zotero bibliography
    WithActiveDocument.Bookmarks
    .AddRange:=Selection.Range,Name:="Zotero_Bibliography"
    .DefaultSorting=wdSortByName
    .ShowHidden=True
    EndWith
    ' loop through each field in the document
    ForEachaFieldInActiveDocument.Fields
    ' check if the field is a Zotero in-text reference
    '##################################################
    IfInStr(aField.Code,"ADDIN ZOTERO_ITEM")>0Then
    fieldCode=aField.Code
    '#############
    ' Prepare
    ' Plain citation== Format of Textfield shown
    ' must be in Brackets
    Dimplain_CitAsString
    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)
    Dimarray_RefTitle(32)AsString
    i=0
    DoWhileInStr(fieldCode,"""title"":""")>0
    n1=InStr(fieldCode,"""title"":""")+Len("""title"":""")
    n2=InStr(Mid(fieldCode,n1,Len(fieldCode)-n1),""",""")-1+n1
    Ifn2<n1Then'Exception the type 'Article'
    n2=InStr(Mid(fieldCode,n1,Len(fieldCode)-n1),"}")-1+n1-1
    EndIf
    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
    DimRefNumber(32)AsString
    i=0
    DoWhile(InStr(plain_Cit,"]")OrInStr(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!
    IfTitles_in_Cit>Refs_in_CitThen
    array_RefTitle(Refs_in_Cit-1)=array_RefTitle(Titles_in_Cit-1)
    i=1
    DoWhileRefs_in_Cit+i<=Titles_in_Cit
    array_RefTitle(Refs_in_Cit+i-1)=""
    i=i+1
    Loop
    EndIf
    '#############
    'Make the links
    ForRefs=0ToRefs_in_Cit-1Step1
    title=array_RefTitle(Refs)
    array_RefTitle(Refs)=""
    ' make title a valid bookmark name
    titleAnchor=title
    titleAnchor=MakeValidBMName(titleAnchor)
    ActiveWindow.View.ShowFieldCodes=False
    Selection.GoToWhat:=wdGoToBookmark,Name:="Zotero_Bibliography"
    '' locate the corresponding reference in the bibliography
    '' by searching for its title
    Selection.Find.ClearFormatting
    WithSelection.Find
    .Text=Left(title,255)
    .Replacement.Text=""
    .Forward=True
    .Wrap=wdFindContinue
    .Format=False
    .MatchCase=False
    .MatchWholeWord=False
    .MatchWildcards=False
    .MatchSoundsLike=False
    .MatchAllWordForms=False
    EndWith
    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
    WithActiveDocument.Bookmarks
    .AddRange:=Selection.Range,Name:=titleAnchor
    .DefaultSorting=wdSortByName
    .ShowHidden=True
    EndWith
    ' jump back to the field
    aField.Select
    ' find and select the numeric part of the field which will become the hyperlink
    Selection.Find.ClearFormatting
    WithSelection.Find
    .Text=RefNumber(Refs)
    .Replacement.Text=""
    .Forward=True
    .Wrap=wdFindContinue
    .Format=False
    .MatchCase=False
    .MatchWholeWord=False
    .MatchWildcards=False
    .MatchSoundsLike=False
    .MatchAllWordForms=False
    EndWith
    Selection.Find.Execute
    numOrYear=Selection.Range.Text&""
    ' store current style
    style=Selection.style
    ' Generate the Hyperlink -->Forward!
    ActiveDocument.Hyperlinks.AddAnchor:=Selection.Range,Address:="",SubAddress:=titleAnchor,ScreenTip:=lnkcap,TextToDisplay:=""&numOrYear
    ' reset the style
    Selection.style=style
    ' comment if you want standard link style
    aField.Select
    WithSelection.Font
    .Underline=wdUnderlineNone
    .ColorIndex=wdBlack
    EndWith
    NextRefs'References in Cit
    EndIf'If Zotero-Field
    '#########################
    NextaField' next field
    ' go back to original range selected
    ActiveWindow.View.ShowFieldCodes=False
    ActiveDocument.Range(nStart,nEnd).Select
    EndSub
    FunctionMakeValidBMName(strInAsString)
    DimpFirstChrAsString
    DimiAsLong
    DimtempStrAsString
    strIn=Trim(strIn)
    pFirstChr=Left(strIn,1)
    IfNotpFirstChrLike"[A-Za-z]"Then
    strIn="A_"&strIn
    EndIf
    Fori=1ToLen(strIn)
    SelectCaseAsc(Mid$(strIn,i,1))
    Case49To57,65To90,97To122
    tempStr=tempStr&Mid$(strIn,i,1)
    CaseElse
    tempStr=tempStr&"_"
    EndSelect
    Nexti
    tempStr=Replace(tempStr," "," ")
    MakeValidBMName=Left(tempStr,40)
    EndFunction
    @sxlllslgh
    Copy link
    Author

    Code is fromZotero forums.

    Sign up for freeto join this conversation on GitHub. Already have an account?Sign in to comment

    [8]ページ先頭

    ©2009-2025 Movatter.jp