为著者出版年制参考文献列表增加书签

Function AddBookmarksToSelectedParagraphs()
    Dim selectedRange As Range
    Dim para As Paragraph
    Dim bookmarkName As String
    Dim regex As Object
    Dim match As Object
    Dim counter As Integer
    
    ' Check if text is selected
    If Selection.Type = wdSelectionIP Then
        MsgBox "Please select some text before running this macro.", vbExclamation
        Exit Sub
    End If
    
    ' Set the selected range
    Set selectedRange = Selection.Range
    
    ' Initialize counter
    counter = 0
    
    ' Loop through each paragraph in the selected range
    For Each para In selectedRange.Paragraphs
        ' Get the text until the first comma and 4-digit number
        bookmarkName = getBookmarkName(para.Range.Text)
        If bookmarkName <> "" Then
            counter = counter + 1
            ActiveDocument.Bookmarks.Add Name:=bookmarkName, Range:=para.Range
        End If
    Next para
    
    Set regex = Nothing
    Debug.Print counter & " Bookmarks added successfully!"
End Function

Function MidBetween(nCursor, strText, strStart, strEnd)
 
    Dim nStart, nEnd
     
    If InStr(nCursor, strText, strStart) = 0 Then
        MidBetween = ""
    Else
        nStart = InStr(nCursor, strText, strStart) + Len(strStart)
        If InStr(nCursor, strText, strEnd) = 0 Then
            nEnd = Len(strText)
        Else
            nEnd = InStr(nStart, strText, strEnd)
        End If
        MidBetween = Mid(strText, nStart, nEnd - nStart)
    End If
     
End Function

Function getBookmarkName(strRef)
    On Error GoTo errhandler
    If strRef = "" Or InStr(1, strRef, ",") = 0 Then Exit Function
    ' Create a regular expression object
    Set regex = CreateObject("VBScript.RegExp")
    regex.Pattern = "(.*?)(\d{4}[a-z\.-])" ' Match text until the first comma, followed by a 4-digit number and a period
    tmp = Replace(strRef, " and ", ", ") & "."
    tmp = regex.Execute(tmp)(0)
    arr = Split(tmp, ", ")
    For i = 0 To UBound(arr)
        If InStr(1, arr(i), " ") Then
            getBookmarkName = getBookmarkName & MidBetween(1, arr(i), "", " ") & "_"
        Else
            getBookmarkName = getBookmarkName & arr(i) & "_"
        End If
    Next i
    getBookmarkName = Mid(getBookmarkName, 1, Len(getBookmarkName) - 1)
    getBookmarkName = Replace(getBookmarkName, ".", "")
    getBookmarkName = Replace(getBookmarkName, "(", "")
    getBookmarkName = Replace(getBookmarkName, "-", "")
    getBookmarkName = UCase(getBookmarkName)
    If Right(getBookmarkName, 1) = "_" Then getBookmarkName = Mid(getBookmarkName, 1, Len(getBookmarkName) - 1)
    Exit Function
    
errhandler:
    Debug.Print Err.Description
    getBookmarkName = ""
End Function