revise 10-29
Sub speciesFirstMentioned()
Dim speciesName
Dim dict
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,}"
.MatchWildcards = True
.Font.Italic = True
.Replacement.Text = ""
.Wrap = wdFindStop
.Forward = True
Do
DoEvents
.Execute
If Not .Found Then
Exit Do
Else
Selection.MoveRight wdWord, 2, wdExtend
If Selection.Range.Italic <> True Then
Selection.MoveLeft wdWord, 2, wdExtend
End If
'获取的时候不用考虑二级标题里的情况,只要标题有物种,正文一定会再出现,仍然可以获取到,如果正文不出现,那也没有检测的意义
If Selection.Range.ParagraphFormat.OutlineLevel <> wdOutlineLevel2 Then
If Selection.Range.HighlightColorIndex <> wdDarkBlue Then
speciesName = Split(Selection.Range.Text, " ")
If UBound(speciesName) = 3 Then
mykey = speciesName(0) + " " + speciesName(1)
myValue = speciesName(2)
Else
mykey = speciesName(0)
myValue = speciesName(1)
End If
If dict.Exists(mykey) = False Then
dict.Add mykey, myValue
Selection.MoveRight wdCharacter, 1
' Else
' Exit Do
End If
End If
End If
End If
i = i + 1
Selection.MoveRight wdCharacter, 1
Loop
For Each key In dict.Keys
If UBound(Split(key, " ")) = 1 Then
searchStr = Left(key, 1) + "[! ]@" + Mid(key, InStr(key, " "), 2) + "[! ]@ " + dict(key)
Else
searchStr = Left(key, 1) + "[! ]@ " + dict(key)
End If
Selection.HomeKey wdStory
With Selection.Find
.ClearFormatting
.Text = searchStr
.MatchWildcards = True
.Wrap = wdFindStop
.Replacement.Text = ""
.Font.Italic = True
.Forward = True
Do
.Execute
If Not .Found Then
Exit Do
Else
If Selection.Range.HighlightColorIndex = wdDarkBlue Then
GoTo findNextSpecies
Else
Select Case j
Case 1
'第一次出现是小写,加comment
If InStr(Selection.Range.Text, ".") > 0 Then
If Selection.Range.HighlightColorIndex = 3 Then
GoTo kr:
Else
Selection.Range.HighlightColorIndex = 3
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."
GoTo kr:
End If
End If
Case Else
'第二次以后出现不是小写加comment
If InStr(Selection.Range.Text, ".") = 0 Then
If Selection.Range.HighlightColorIndex <> 3 Then
If Selection.Range.ParagraphFormat.OutlineLevel = wdOutlineLevel2 Then
Selection.Range.Italic = False
Selection.Range.HighlightColorIndex = 3
Selection.Range.comments.Add Selection.Range, "after First time mentioned in the abstract, main text and figures/tables both genus and species names should be abbreviated."
Else
Selection.Range.HighlightColorIndex = 3
Selection.Range.comments.Add Selection.Range, "after First time mentioned in the abstract, main text and figures/tables both genus and species names should be abbreviated."
End If
Else
GoTo kr:
End If
Else
GoTo kr:
End If
End Select
End If
End If
kr:
j = j + 1
Loop
End With
findNextSpecies:
j = 1
Next
End With
myrange.refPart.Select
Selection.Range.HighlightColorIndex = wdAuto
Set dict = Nothing
End Sub