Cacher is the code snippet organizer for pro developers

Sub 给正文中的引用加链接()

Call layout_search_replace.ZRjump_to_reference_section
Dim MainR As Range
Dim mainText As String
Dim mainrange As Range
Dim MainCount As Integer

With selection.Find
  .Text = "\([A-Z][!^13\(]@[0-9]{4}\)"
  .Style = "_8_reference"
  .MatchWildcards = True
  .Wrap = wdFindStop
  Do
  .Execute
    If Not .Found Then
      Exit Do
    End If
    If .Found Then
    Dim Kstr As String
    Kstr = selection.Range.Text
    Kstr = Right(Left(Kstr, Len(Kstr) - 1), Len(Kstr) - 2)
    Dim namestr, yearstr, kuostr As String
    arr = Split(Kstr, ",")
    namestr = arr(0)
    yearstr = Right(arr(1), 4)
    kuostr = namestr + " (" + yearstr + ")"
    Dim label, i As Integer
    label = selection.Range.ListParagraphs(1).Range.ListFormat.ListValue
 selection.collapse wdCollapseEnd
 
ActiveDocument.Range.Select
      With ActiveDocument.Content.Find
        .ClearFormatting
        .Text = Kstr
        .Replacement.Text = "\citealp{" + CStr(label) + "}"
        .Execute Replace:=wdReplaceAll
      End With
      
ActiveDocument.Range.Select
       With ActiveDocument.Content.Find
        .ClearFormatting
        .Text = kuostr
        .Replacement.Text = "\cite{" + CStr(label) + "}"
        .Execute Replace:=wdReplaceAll
      End With
    End If
    
  Loop
End With

Call layout_search_replace.jump_to_reference_section
With selection.Find
.ClearFormatting
.Wrap = wdFindStop
.Forward = True
  .Text = "\([A-Z][!^13\(]@[0-9]{4}[A-Za-z]\)"
  .Replacement.Text = ""
  .Style = "_8_reference"
  .MatchWildcards = True
  
  Do
  .Execute
    If Not .Found Then
      Exit Do
    End If
    If .Found Then
    Dim Kstr1 As String
    Kstr1 = selection.Range.Text
    If Kstr1 = "" Then
    Exit Do
    End If
    Kstr1 = Right(Left(Kstr1, Len(Kstr1) - 1), Len(Kstr1) - 2)
    Dim namestr1, yearstr1, kuostr1 As String
    arr1 = Split(Kstr1, ",")
    namestr1 = arr1(0)
    yearstr1 = Right(arr1(1), 5)
    kuostr1 = namestr1 + " \(" + yearstr1 + "\)"
    
    Dim label1
    label1 = selection.Range.ListParagraphs(1).Range.ListFormat.ListValue
 selection.collapse wdCollapseEnd
ActiveDocument.Range.Select
      With ActiveDocument.Content.Find
        .ClearFormatting
        .Text = Kstr1
        .Replacement.Text = "\citealp{" + CStr(label) + "}"
        .Execute Replace:=wdReplaceAll
      End With
      
       With ActiveDocument.Content.Find
        .ClearFormatting
        .Text = kuostr1
        .Replacement.Text = "\cite{" + CStr(label) + "}"
        .Execute Replace:=wdReplaceAll
      End With
  
    End If
  Loop
End With

With ActiveDocument.Content.Find
  .Text = "\(\\citealp\{[0-9]{1,}\}\) "
  .Replacement.Text = ""
  .MatchWildcards = True
  .Font.ColorIndex = wdAuto
  .Execute Replace:=wdReplaceAll
End With

End Sub