text 调整作者名和姓的顺序加评论

Posted 2021-05-03

Sub 调整作者名加comment()
Dim myrange As Range
 With selection.Find
    .Text = "[A-Z][A-Za-z]{1,}\, [A-Z]\."
    .MatchWildcards = True
    .Wrap = wdFindStop
    .Forward = True
    Do
    .Execute
        If .Found And selection.Range.Previous(wdCharacter, 2) <> ")" Then
        selection.MoveEndUntil ".,"
        selection.MoveRight wdCharacter, 1, wdExtend
        Set myrange = selection.Range
                myrange.Select
                myrange.SetRange Start:=selection.Range.Start + 1 + InStr(selection.Range, ","), End:=selection.Range.End
                myrange.HighlightColorIndex = wdYellow
                myrange.Comments.Add Range:=myrange, Text:="sss"
                myrange.Cut
                selection.collapse wdCollapseStart
                selection.Paste
                selection.TypeText " "
                If selection.Range.Next = "," Then
                selection.MoveRight wdCharacter, 1, wdExtend
                Set myrange = selection.Range
                myrange.Select
                myrange.SetRange Start:=selection.Range.Start + 1 + InStr(selection.Range, ","), End:=selection.Range.End
                myrange.HighlightColorIndex = wdYellow
                myrange.Comments.Add Range:=myrange, Text:="sss"
                myrange.Cut
                selection.collapse wdCollapseStart
                selection.Paste
                selection.TypeText " "
                End If
        End If
    Loop
End With
End Sub