kerrypnx
10/24/2018 - 6:21 AM

for genes

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