revise 10-24
Sub speciesFirstMentioned()
Set dict = CreateObject("Scripting.Dictionary")
Dim i, j As Integer
i = 1: j = 1
Dim myrange As New myrange
myrange.refPart.Select
Selection.Range.HighlightColorIndex = wdDarkBlue
Selection.HomeKey wdStory
With Selection.Find
.ClearFormatting
.Text = "[A-Z][a-z]{1,} [a-z]{1,}"
.MatchWildcards = True
.Font.Italic = True
.Replacement.Text = ""
.Wrap = wdFindStop
.Forward = True
Do
DoEvents
.Execute
If Not .Found Then
Exit Do
Else
'获取的时候不用考虑二级标题里的情况,只要标题有物种,正文一定会再出现,仍然可以获取到,如果正文不出现,那也没有检测的意义
If Selection.Range.ParagraphFormat.OutlineLevel <> wdOutlineLevel2 Then
If Selection.Range.HighlightColorIndex <> wdDarkBlue Then
If dict.Exists(Selection.Text) = False Then
dict.Add Selection.Text, CStr(i)
Else
Exit Do
End If
End If
End If
End If
i = i + 1
Loop
Dim key
For Each key In dict.Keys
Selection.HomeKey wdStory
With Selection.Find
.ClearFormatting
.Text = key
.MatchWildcards = False
.Wrap = wdFindStop
.Forward = True
Do
.Execute
If Not .Found Then
Exit Do
Else
If j = 1 Then
Else
If Selection.Range.HighlightColorIndex <> wdDarkBlue Then
If Selection.Range.ParagraphFormat.OutlineLevel = wdOutlineLevel2 Then
Selection.Range.Italic = False
Selection.Range.HighlightColorIndex = wdYellow
Selection.Range.comments.Add Selection.Range, "First time mentioned in the abstract, main text and figures/tables both genus and species names should be written full name (Escherichia coli); after they should be abbreviated (E. coli)."
Else
Selection.Range.HighlightColorIndex = wdYellow
Selection.Range.comments.Add Selection.Range, "First time mentioned in the abstract, main text and figures/tables both genus and species names should be written full name (Escherichia coli); after they should be abbreviated (E. coli)."
End If
Else
GoTo kr
End If
End If
End If
j = j + 1
Loop
End With
Next
End With
kr:
myrange.refPart.Select
Selection.Range.HighlightColorIndex = wdAuto
End Sub
Sub greekLetters()
'detecte Alpha, beta, gamma
Dim aimT, replaceT
arr = "Gamma,beta,Alpha"
arr1 = "947,946,945"
aimT = Split(arr, ",")
replaceT = Split(arr1, ",")
For i = LBound(aimT) To UBound(aimT)
With Selection.Find
.ClearFormatting
.Text = aimT(i)
.MatchCase = False
.Replacement.Text = ChrW(replaceT(i))
.MatchWildcards = False
.Wrap = wdFindContinue
.Forward = True
Do
.Execute
If Not .Found Then
Exit Do
Else
Selection.Text = ChrW(replaceT(i))
Selection.MoveRight wdCharacter, 1
End If
Loop
End With
Next
End Sub
Sub noItalicSpecies()
Dim aimT, replaceT
arr = "CpG,DNA,RNA,dsDNA,rRNA,PCR,RT-PCR,qPCR,N-terminal,C-terminal"
aimT = Split(arr, ",")
For i = LBound(aimT) To UBound(aimT)
With Selection.Find
.ClearFormatting
.Text = aimT(i)
.MatchCase = False
.MatchWildcards = False
.Wrap = wdFindContinue
.Forward = True
Do
.Execute
If Not .Found Then
Exit Do
Else
Selection.Font.Italic = False
Selection.MoveRight wdCharacter, 1
End If
Loop
End With
Next
End Sub
Sub ItalicSpecies()
Dim aimT, replaceT
arr = "is,trans,FUT4,HOX"
aimT = Split(arr, ",")
For i = LBound(aimT) To UBound(aimT)
With Selection.Find
.ClearFormatting
.Text = aimT(i)
.MatchCase = False
.MatchWildcards = False
.Wrap = wdFindContinue
.Forward = True
Do
.Execute
If Not .Found Then
Exit Do
Else
If Selection.Range.ParagraphFormat.OutlineLevel = wdOutlineLevel2 Then
Selection.Font.Italic = False
Selection.MoveRight wdCharacter, 1
Else
Selection.Font.Italic = True
Selection.MoveRight wdCharacter, 1
End If
End If
Loop
End With
Next
End Sub
Sub dataNoShown()
Dim aimT, replaceT
With Selection.Find
.ClearFormatting
.Text = "Data not shown"
.MatchCase = False
.MatchWildcards = False
.Wrap = wdFindContinue
.Forward = True
Do
.Execute
If Not .Found Then
Exit Do
Else
Selection.Range.HighlightColorIndex = wdYellow
Selection.Range.comments.Add Selection.Range, "Can be removed the statement or included the data?"
End If
Loop
End With
End Sub