text 超过两个作者名修改为等

Posted 2021-05-03

Sub more2Name2etal()
Dim myrange As Range
selection.HomeKey wdStory
With selection.Find
    .Text = "[A-Z][a-z]{1,}\, [A-Z][a-z]{1,}\,[!0-9]{1,}2[0-9]{3}"
    .MatchWildcards = True
    .ClearFormatting
    .Replacement.ClearFormatting
    .Forward = True
    .Wrap = wdFindStop
    Do
    .Execute
    If Not .Found Then
    Exit Do
    End If
    If .Found Then
     If InputBox("Is this a reference call-out?  Replace more than one author name to et al?", "Possible Reference Call-out Detected", "yes", 300, 300) = "yes" Then
    Set myrange = selection.Range
    myrange.Select
    myrange.SetRange selection.Range.Start + InStr(selection.Range, ",") - 1, selection.Range.Start + InStr(selection.Range, "2") - 1
    myrange.Text = " et al. "
    selection.collapse wdCollapseEnd
    End If
    End If
    Loop
End With


selection.HomeKey wdStory
With selection.Find
    .Text = "[A-Z][a-z]{1,}\, [A-Z][a-z]{1,}\,[!0-9]{1,}1[0-9]{3}"
    .MatchWildcards = True
    .ClearFormatting
    .Replacement.ClearFormatting
    .Forward = True
    .Wrap = wdFindStop
    Do
    .Execute
    If Not .Found Then
    Exit Do
    End If
    If .Found Then
     If InputBox("Is this a reference call-out?  Replace more than one author name to et al?", "Possible Reference Call-out Detected", "yes", 300, 300) = "yes" Then
    Set myrange = selection.Range
    myrange.Select
    myrange.SetRange selection.Range.Start + InStr(selection.Range, ",") - 1, selection.Range.Start + InStr(selection.Range, "1") - 1
    myrange.Text = " et al. "
    selection.collapse wdCollapseEnd
    End If
    End If
    Loop
End With
End Sub