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