kerrypnx
10/24/2018 - 2:53 AM

species first mentioned

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