kerrypnx
9/11/2018 - 9:52 AM

ten name

revise 9-11

Sub layout_ten_name()
    
    ActiveDocument.AcceptAllRevisions
    ActiveDocument.TrackRevisions = False

    Call addDotForGivenAbbr
     
    Call addDotForFamily
 
    Call addSemicolon

    Call ten_name
    
End Sub
Sub addDotForGivenAbbr()
    Call layout_search_replace.jump_to_reference_section
    Dim extendT, oriT As Integer
kr:
    
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "(<[A-Z]>)([!.])"
        .Replacement.Text = "\1.\2"
        .Forward = True
        .Wrap = wdFindStop
        .Font.Italic = False
        .MatchWildcards = True
        Do
            .Execute
            If Not .Found Then
                
                Exit Sub
            Else
                oriT = Len(Selection.Text)
                Selection.MoveRight wdCharacter, 20, wdExtend
                
                extendT = Len(Selection.Text)
                
                If InStr(Selection.Text, ",") = 0 Or InStr(Selection.Text, ".") = 0 Or FunctionGroup.existNum(Selection.Text) = True Then
                    Selection.MoveRight wdCharacter, 1
                    GoTo kr
                Else
                    Selection.MoveLeft wdCharacter, extendT - oriT + 1, wdExtend
                    If InputBox("Do you want to change A to A.", "A to A.", "yes", 300, 300) = "yes" Then
                    Selection.InsertAfter "."
                    Selection.MoveRight wdCharacter, 1
                Else
                    Selection.MoveRight wdCharacter, 1
                End If
            End If
        End If
        DoEvents
    Loop
End With
End Sub
Sub addDotForFamily()
Call layout_search_replace.jump_to_reference_section
With Selection.Find
    .ClearFormatting
    .Text = "([A-Z][a-z]{1,})( <[A-Z]>.)"
    .Font.Italic = False
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindStop
    
    .MatchWildcards = True
    Do
        .Execute
        If Not .Found Then
            
            Exit Sub
        Else
            
            Selection.MoveLeft wdCharacter, 3, wdExtend
            If InputBox("Do you want to change Abc to Abc,", "Abc to Abc,", "yes", 300, 300) = "yes" Then
            
            Selection.InsertAfter ","
            Selection.MoveRight wdCharacter, 1
                Else
            Selection.MoveRight wdCharacter, 1
            End If
    End If
    
Loop

End With
End Sub
Sub addSemicolon()
Call layout_search_replace.jump_to_reference_section
With Selection.Find
        .ClearFormatting
        .Text = "[A-Z]. [A-Z][a-z]{1,}, [A-Z]"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindStop
        .Font.Italic = False
        .MatchWildcards = True
        Do
       DoEvents
        .Execute
        If Not .Found Then
        'MsgBox "We can't find what you are looking for", vbInformation + vbOKOnly
        Exit Sub
        Else
                    Selection.Collapse wdCollapseStart
                    Selection.MoveRight wdCharacter, 2, wdExtend
                  If InputBox("Do you want to change A. to A.;", "A. to A.;", "yes", 300, 300) = "yes" Then
                     Selection.Collapse wdCollapseEnd
                    Selection.InsertAfter ";"
                      Selection.MoveRight wdCharacter, 1
                    Else
                    Selection.MoveRight wdCharacter, 1
                End If
        End If
        
        Loop
    End With
End Sub
Sub ten_name()
Application.Options.DefaultHighlightColorIndex = wdBrightGreen
Call layout_search_replace.jump_to_reference_section

Dim myrange As Range
Set myrange = ActiveDocument.Range(Selection.Range.Start, ActiveDocument.Range.End)
myrange.Select
With myrange.Find
.ClearFormatting
.Text = "([A-Z])(\; [A-Z])"
.MatchWildcards = True
.Replacement.Text = "\1.\2"
.Replacement.Highlight = True
.Forward = True
.Wrap = wdFindStop
.Execute Replace:=wdReplaceAll
End With
Dim reg As Object, p As paragraph, mt

Set reg = CreateObject("VBScript.Regexp")
reg.Global = True
reg.Pattern = ", ([A-Z]\.)+"  'revise 9-4
For Each p In myrange.Paragraphs

If reg.Execute(p.Range.Text).count > 10 Then
    
    m = reg.Execute(p.Range.Text)(9).firstindex + Len(reg.Execute(p.Range.Text)(9)) + 2
    n = reg.Execute(p.Range.Text)(10).firstindex + Len(reg.Execute(p.Range.Text)(10))
    ActiveDocument.Range(p.Range.Start + m, p.Range.Start + n).HighlightColorIndex = 6
End If

If reg.Execute(p.Range.Text).count > 1 And reg.Execute(p.Range.Text).count < 10 And InStr(p, "et al") > 0 Then
    m = InStr(p, "et al") - 1
    n = InStr(p, "et al") + 5
    ActiveDocument.Range(p.Range.Start + m, p.Range.Start + m + 5).HighlightColorIndex = wdYellow
    
End If
Next
MsgBox "done"
End Sub