kerrypnx
8/7/2018 - 8:27 AM

文献引用加入文献的comment-18-8-7

revise 8-22

Sub CrossRef(ByVal control As IRibbonControl)
    Dim aimT As String
    Dim arr() As String
    Call kr_deck.aselect_whole_reference
    Dim wholeRef As String
    wholeRef = Selection.Range.Text
    arr = Split(wholeRef, ChrW(13))
    
    With Selection.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Text = "[A-Z][!^13 ]{1,} [!^13 ]{1,} \[[0-9]{1,}\]"
        .MatchWildcards = True
        .Wrap = wdFindContinue
        .Forward = True
        Do
            .Execute
            If Not .Found Then
                Exit Do
            Else
                aimT = FunctionGroup.getRefNum(Selection.Range.Text)
                If InStr(arr(CStr(aimT) - 1), Trim(Selection.Range.Words(1))) > 0 _
                    And InStr(arr(CStr(aimT) - 1), Trim(Selection.Range.Words(2))) > 0 Then
                    Selection.Range.HighlightColorIndex = wdRed
                    Selection.Range.comments.Add Selection.Range, arr(CStr(aimT) - 1) + " WAITDELETE"
                End If
            End If
        Loop
    End With
    Selection.HomeKey wdStory
End Sub


Sub DeleteRedComment(ByVal control As IRibbonControl)
    
    Dim com As Comment
    Dim copyt, aimT As String
    Dim i As Integer
    i = 1
    copyt = ""
    For Each com In ActiveDocument.comments
        If com.Range.Words.Last.Text = "WAITDELETE" Then
            com.Scope.HighlightColorIndex = wdAuto
            com.DeleteRecursively
            i = i + 1
        End If
        '  If com.Scope.HighlightColorIndex = wdRed Then
        '  com.Scope.HighlightColorIndex = wdAuto
        '  com.DeleteRecursively
        '  i = i + 1
        
        'End If
    Next
    MsgBox "done"
End Sub