vbscript 7.检测图/表/方案是否多引漏引，提及在图片/表格后面也需提醒

Posted 2021-05-21

Sub DetectCaption()
    Call kr_deck.ClearF
    arr = "Table,Figure,Scheme,Algorithm"
    arr1 = "Tables,Figures,Schemes,Algorithms"
    cite = Split(arr, ",")
    cites = Split(arr1, ",")
    For i = LBound(cite) To UBound(cite)
        splitCitations (cites(i))
        existCaption (cite(i))
    Next
End Sub

Sub splitCitations(str As String)
    With Selection.Find
        .Text = str + " [0-9]{1,}–[0-9]{1,}"
        .MatchWildcards = True
        .Replacement.Text = ""
        .Wrap = wdFindContinue
        Do
            .Execute
            If Not .Found Then
                Exit Do
            Else
                Selection.Text = FunctionGroup.splitCitations(Selection.Text, " " + Replace(str, "s", "") + " ")
            End If
        Loop
    End With
    
    With Selection.Find
        .Text = str + " [0-9]{1,} and [0-9]{1,}"
        .MatchWildcards = True
        .Replacement.Text = ""
        .Wrap = wdFindContinue
        Do
            .Execute
            If Not .Found Then
                Exit Do
            Else
   
                Selection.Text = FunctionGroup.splitCitationsAnd(Selection.Text, " " + Replace(str, "s", "") + " ")
            End If
        Loop
    End With
End Sub

Sub existCaption(str As String)
    Selection.HomeKey wdStory
    With Selection.Find
        .Text = str + " [0-9]{1,}"
        .MatchWildcards = True
        .Wrap = wdFindStop
        .Font.Bold = 0
        .Replacement.Text = ""
        Do
            .Execute
            If Not .Found Then
                Exit Do
            Else
                If existCitation(Selection.Text) = False Then
                    Selection.Range.comments.Add Selection.Range, "sss"
                Else
                    '如果加粗的figure 1 和不加粗的都同时存在文中，那么肯定是不多也不少的
                    '在这种情况下，如果加粗的figure 1不存在于后面，那么就是在前面提及了
                    citationBefore (Selection.Text)
                End If
            End If
        Loop
    End With
End Sub
Function existCitation(str As String) As Boolean
    existCitation = False
    With ThisDocument.Content.Find
        .Text = str
        .Font.Bold = -1
        .Wrap = wdFindContinue
        .Execute
        If .Found Then
            existCitation = True
        End If
    End With
End Function
Sub citationBefore(str As String)
Dim myrange As Range
    Set myrange = ActiveDocument.Range(Selection.End, ActiveDocument.Range.End)
    With myrange.Find
        .ClearFormatting
        .Font.Bold = -1
        .Text = str
        .Forward = True
        .MatchWildcards = False
        .Wrap = wdFindStop
        .Execute
        If .Found = False Then
            Selection.Range.HighlightColorIndex = wdYellow
            Selection.Range.comments.Add Selection.Range, str + " caption is in front of citation"
        End If
        
    End With
End Sub