Cacher is the code snippet organizer for pro developers

Sub ZR_aAdd_authorName_year()

Call layout_search_replace.jump_to_reference_section

With selection.Find
.ClearFormatting
.Replacement.ClearFormatting

    .Text = "^13[!一-龥^13]@[0-9]{4}[abcd]"
    .Replacement.Text = ""
    .MatchWildcards = True
    .Wrap = wdFindStop
    Do
    .Execute
    If Not .Found Then
    Exit Do
    End If
    If .Found Then '
    Dim myrange1 As Range
    Set myrange1 = selection.Range
    myrange1.Select
    myrange1.SetRange selection.Range.Start + 1, selection.Range.End
    myrange1.Select
    selection.Range = ZRcountNameAB(selection.Range.Text)
    End If
    Loop
End With



Call layout_search_replace.jump_to_reference_section

With selection.Find
.ClearFormatting
.Replacement.ClearFormatting

    .Text = "^13[!一-龥^13]@[0-9]{4}"
    .Replacement.Text = ""
    .MatchWildcards = True
    .Wrap = wdFindStop
    Do
    .Execute
    If Not .Found Then
    Exit Do
    End If
    If .Found Then '
    Dim myrange As Range
    Set myrange = selection.Range
    myrange.Select
    myrange.SetRange selection.Range.Start + 1, selection.Range.End
    myrange.Select
    selection.Range = ZRcountName(selection.Range.Text)
    End If
    Loop
End With

Call zhongwen_aAdd_authorName_year

End Sub
Function ZRcountNameAB(AnySrt As String)
Dim i As Integer
Dim RegEx
Dim myname As String
Set RegEx = CreateObject("vbscript.regexp")
With RegEx
    .Global = True
    .Pattern = "\,"
End With
Select Case RegEx.Execute(selection.Text).count

Case Is = 2

If InStr(selection.Text, ".") > 0 Then
    myname = "(" + Left(selection.Range, InStr(selection.Range, ",") - 1) + ", " + Right(selection.Range, 5) + ")"
    selection.Range = myname + " " + selection.Range
End If

Case Is = 4

Dim arr
  arr = Split(AnySrt, ",")

  If InStr(selection.Text, ".") > 0 Then
  
  myname = "(" + Left(selection.Range, InStr(selection.Range, ",") - 1) + " and " + Trim(arr(2)) + ", " + Right(selection.Range, 5) + ")"

  selection.Range = myname + " " + selection.Range

End If


Case Is > 4
    myname = "(" + Left(selection.Range, InStr(selection.Range, ",") - 1) + " " + "et al., " + Right(selection.Range, 5) + ")"
    selection.Range = myname + " " + selection.Range
    
End Select
ZRcountNameAB = selection.Range
Set RegEx = Nothing
End Function
Function ZRcountName(AnySrt As String)
Dim i As Integer
Dim RegEx
Dim myname As String
Set RegEx = CreateObject("vbscript.regexp")
With RegEx
    .Global = True
    .Pattern = "\,"
End With
Select Case RegEx.Execute(selection.Text).count
Case Is = 2
If InStr(selection.Text, ".") > 0 Then
    myname = "(" + Left(selection.Range, InStr(selection.Range, ",") - 1) + ", " + Right(selection.Range, 4) + ")"
    selection.Range = myname + " " + selection.Range
End If
Case Is = 4
Dim arr
arr = Split(AnySrt, ",")


  
  myname = "(" + Left(selection.Range, InStr(selection.Range, ",") - 1) + " and " + Trim(arr(2)) + ", " + Right(selection.Range, 4) + ")"
  selection.Range = myname + " " + selection.Range




Case Is > 4
    myname = "(" + Left(selection.Range, InStr(selection.Range, ",") - 1) + " " + "et al., " + Right(selection.Range, 4) + ")"
    selection.Range = myname + " " + selection.Range
End Select
ZRcountName = selection.Range
Set RegEx = Nothing
End Function


Sub zhongwen_aAdd_authorName_year()
Call layout_search_replace.jump_to_reference_section
With selection.Find
  .ClearFormatting
  .Replacement.ClearFormatting
  .Text = "附中文参考文献"
  .MatchWildcards = False
  .Font.Bold = -1
  .Wrap = wdFindContinue
  .Execute
End With

Dim myrangref As Range
Set myrangeref = ActiveDocument.Range(selection.Range.Start, ActiveDocument.Range.End)
myrangeref.Select
With selection.Find
  .ClearFormatting
  .Replacement.ClearFormatting
  .Text = ChrW(65292)
  .MatchWildcards = False
  .Replacement.Text = ","
  .Wrap = wdFindStop
  .Execute Replace:=wdReplaceAll
End With




With selection.Find
  .ClearFormatting
  .Replacement.ClearFormatting
  .Text = "附中文参考文献"
  .MatchWildcards = False
  .Font.Bold = -1
  .Wrap = wdFindContinue
  .Execute
End With

selection.collapse wdCollapseEnd
'Call layout_search_replace.jump_to_reference_section

With selection.Find
.ClearFormatting
.Replacement.ClearFormatting

    .Text = "^13[!^13]@[0-9]{4}[abcd]"
    .Replacement.Text = ""
    .MatchWildcards = True
    .Wrap = wdFindStop
    Do
    .Execute
    If Not .Found Then
    Exit Do
    End If
    If .Found Then '
    Dim myrange1 As Range
    Set myrange1 = selection.Range
    myrange1.Select
    myrange1.SetRange selection.Range.Start + 1, selection.Range.End
    myrange1.Select
    selection.Range = zhongwencountNameAB(selection.Range.Text)
    End If
    Loop
End With



'Call layout_search_replace.jump_to_reference_section

With selection.Find
.ClearFormatting
.Replacement.ClearFormatting

    .Text = "^13[!^13]@[0-9]{4}"
    .Replacement.Text = ""
    .MatchWildcards = True
    .Wrap = wdFindStop
    Do
    .Execute
    If Not .Found Then
    Exit Do
    End If
    If .Found Then '
    Dim myrange As Range
    Set myrange = selection.Range
    myrange.Select
    myrange.SetRange selection.Range.Start + 1, selection.Range.End
    myrange.Select
    selection.Range = zhongwencountName(selection.Range.Text)
    End If
    Loop
End With


End Sub
Function zhongwencountNameAB(AnySrt As String)
Dim i As Integer
Dim RegEx
Dim myname As String
Set RegEx = CreateObject("vbscript.regexp")
With RegEx
    .Global = True
    .Pattern = "\,"
End With
Select Case RegEx.Execute(selection.Text).count

Case Is = 2

If InStr(selection.Text, ".") > 0 Then
    myname = "(" + Left(selection.Range, InStr(selection.Range, ",") - 1) + "，" + Right(selection.Range, 5) + ")"
    selection.Range = myname + " " + selection.Range
End If

Case Is = 4

Dim arr
  arr = Split(AnySrt, ",")

  If InStr(selection.Text, ".") > 0 Then
  
  myname = "(" + Left(selection.Range, InStr(selection.Range, ",") - 1) + " and " + Trim(arr(1)) + "，" + Right(selection.Range, 5) + ")"

  selection.Range = myname + " " + selection.Range

End If


Case Is > 4
    myname = "(" + Left(selection.Range, InStr(selection.Range, ",") - 1) + " " + "等，" + Right(selection.Range, 5) + ")"
    selection.Range = myname + " " + selection.Range
    
End Select
zhongwencountNameAB = selection.Range
Set RegEx = Nothing
End Function
Function zhongwencountName(AnySrt As String)
Dim i As Integer
Dim RegEx
Dim myname As String
Set RegEx = CreateObject("vbscript.regexp")
With RegEx
    .Global = True
    .Pattern = "\,"
End With
Select Case RegEx.Execute(selection.Text).count
Case Is = 1

    myname = "(" + Left(selection.Range, InStr(selection.Range, ",") - 1) + "，" + Right(selection.Range, 4) + ")"
    selection.Range = myname + " " + selection.Range

Case Is = 2
Dim arr
arr = Split(AnySrt, ",")


  
  myname = "(" + Left(selection.Range, InStr(selection.Range, ",") - 1) + "和" + Trim(arr(1)) + "，" + Right(selection.Range, 4) + ")"
  selection.Range = myname + " " + selection.Range




Case Is > 2
    myname = "(" + Left(selection.Range, InStr(selection.Range, ",") - 1) + "等，" + Right(selection.Range, 4) + ")"
    selection.Range = myname + " " + selection.Range
End Select
zhongwencountName = selection.Range
Set RegEx = Nothing
End Function