text 芝加哥删除页码;文献引用，换名字，评论

Posted 2021-05-03

Sub DeletePage(ByVal control As IRibbonControl)
   
selection.HomeKey wdStory
With selection.Find
    .Text = " ([0-9]{3})[–-]([0-9])([0-9])([0-9])"   '三位数
    .MatchWildcards = True
    .ClearFormatting
    .Forward = True
    .Replacement.Text = ""
    .Wrap = wdFindStop
    Do
    .Execute
    If Not .Found Then
    Exit Do
    End If
    If .Found And selection.Range.Characters(2) = selection.Range.Characters(6) Then
    selection.Range.HighlightColorIndex = wdBrightGreen
    .Replacement.Text = " \1–\3\4"
    .Execute Replace:=wdReplaceOne
    If selection.Range.Characters(6).Text = "0" Then
    selection.Range.Characters(6).Delete
    End If

    End If
    Loop
End With


selection.HomeKey wdStory
With selection.Find
    .Text = " ([0-9]{4})[–-]([0-9])([0-9])([0-9]{2})" '四位数
    .MatchWildcards = True
    .ClearFormatting
    .Forward = True
    .Replacement.Text = ""
    
    .Wrap = wdFindStop
    Do
    .Execute
    If Not .Found Then
    Exit Do
    End If
    If .Found And selection.Range.Characters(2) = selection.Range.Characters(7) Then
    selection.Range.HighlightColorIndex = wdBrightGreen
        If selection.Range.Characters(3) = selection.Range.Characters(8) Then
            .Replacement.Text = " \1–\4"
            .Execute Replace:=wdReplaceOne
            If selection.Range.Characters(7).Text = "0" Then
            selection.Range.Characters(7).Delete
            End If
        Else
            .Replacement.Text = " \1–\3\4"
            .Execute Replace:=wdReplaceOne
     

        End If
    
    End If
    selection.collapse wdCollapseEnd
    Loop
End With



selection.HomeKey wdStory
With selection.Find
    .Text = " ([0-9]{5})[–-]([0-9])([0-9])([0-9])([0-9]{2})" '五位数
    .MatchWildcards = True
    .ClearFormatting
    .Forward = True
    .Replacement.Text = ""
    
    .Wrap = wdFindStop
    Do
    .Execute
    If Not .Found Then
    Exit Do
    End If
    If .Found And selection.Range.Characters(2) = selection.Range.Characters(8) Then
    selection.Range.HighlightColorIndex = wdBrightGreen
        If selection.Range.Characters(3) = selection.Range.Characters(9) Then
        
            If selection.Range.Characters(4) = selection.Range.Characters(10) Then
                .Replacement.Text = " \1–\5"
                .Execute Replace:=wdReplaceOne
                    If selection.Range.Characters(8) = 0 Then
                        selection.Range.Characters(8).Delete
                    End If
            Else
            .Replacement.Text = "\1–\4\5"
            .Execute Replace:=wdReplaceOne
            End If
        Else
        .Replacement.Text = "\1–\3\4\5"
        .Execute Replace:=wdReplaceOne
        End If
    
    
    End If
    

    
    Loop
End With

End Sub
Sub ExchangeName(ByVal control As IRibbonControl)
Dim myrange As Range

  Call layout_search_replace.jump_to_reference_section
     With selection.Find
    .Text = "[A-Z][A-Za-z]{1,}\, [A-Z]\."
    .MatchWildcards = True
    .Wrap = wdFindStop
    .Forward = True
    Do
    .Execute
        If Not .Found Then
        Exit Do
        End If
        If .Found And selection.Range.Previous(wdCharacter, 2) <> ")" And Asc(selection.Range.Previous(wdCharacter, 1)) <> 13 Then
'        If IsNumeric(selection.Range.Next(wdCharacter, 5)) = False Then
'        selection.MoveEndUntil "."
'        'selection.MoveEndWhile ".,"
'        End If
If selection.Range.Next = "," Then
selection.MoveRight wdCharacter, 1, wdExtend
End If
        selection.MoveRight wdCharacter, 1, wdExtend
        Set myrange = selection.Range
                myrange.Select
                myrange.SetRange Start:=selection.Range.Start + 1 + InStr(selection.Range, ","), End:=selection.Range.End
                myrange.HighlightColorIndex = wdYellow
                
                myrange.Cut
                selection.collapse wdCollapseStart
                selection.Paste
                'selection.Comments.Add Range:=ActiveDocument.Range(Start:=selection.Range.Start - 3, End:=selection.Range.Start), Text:="The authors name please use full name."
                'selection.TypeText ", "
                If selection.Range.Next = "," Then
                selection.MoveRight wdCharacter, 1, wdExtend
                Set myrange = selection.Range
                myrange.Select
                myrange.SetRange Start:=selection.Range.Start + 1 + InStr(selection.Range, ","), End:=selection.Range.End
                myrange.HighlightColorIndex = wdYellow
             
                myrange.Cut
                selection.collapse wdCollapseStart
                selection.Paste
               ' selection.Comments.Add Range:=ActiveDocument.Range(Start:=selection.Range.Start - 3, End:=selection.Range.Start), Text:="The authors name please use full name."
                selection.TypeText " "
                End If
        End If
    Loop
    End With
End Sub


Sub RefCite(ByVal control As IRibbonControl)
Dim MainR As Range
Dim mainrange As Range
Dim MainCount As Integer
Call word2html.change_web_layout
Call word2html.save_filtered_html
Dim DocPath As String
DocPath = ActiveDocument.Path

ActiveDocument.Close
Dim fso As Object, sFile As Object

Set fso = CreateObject("Scripting.FileSystemObject")
Set sFile = fso.OpenTextFile("C:\Users\MDPI\AppData\Roaming\Microsoft\Templates\Auxiliary_line.docx")



Dim doc
Set doc = Documents.Open(FileName:=DocPath & "\forMerrin.htm", Visible:=True)
sFile.Close
Set fso = Nothing
Set sFile = Nothing

    With doc
    Call kr_deck.aselect_whole_reference           '文献给style
    
    selection.Style = ActiveDocument.Styles("_4_text_citation")
        Dim arr
        Dim monthKr
        Dim i As Long
   

        arr = "January,February,March,April,May,June,July,August,September,October,November,December"
        monthKr = Split(arr, ",")
  
    
    selection.HomeKey wdStory
     With selection.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        
        .Text = "\([!0-9\(\)][!\(\)]@[0-9]{4}\)"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
        Do
        .Execute
        If Not .Found Then
        Exit Do
        End If
        If .Found And InStr(selection.Range, "=") = 0 Then
        
        For i = LBound(monthKr) To UBound(monthKr)
       
        If InStr(selection.Range, monthKr(i)) > 0 Then
        
       selection.collapse wdCollapseEnd
        Exit For
        End If
        Next i
        selection.Style = ActiveDocument.Styles("_4_text_citation")
         selection.collapse wdCollapseEnd
        End If
        Loop
    End With
   
   
       selection.HomeKey wdStory
     With selection.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Highlight = False
        .Text = "\([!0-9\(\)][!\(\)]@[0-9]{4}[!\)]{1,}\)"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
        Do
        .Execute
        If Not .Found Then
        Exit Do
        End If
        If .Found And InStr(selection.Range, "=") = 0 Then
        
        For i = LBound(monthKr) To UBound(monthKr)
       
        If InStr(selection.Range, monthKr(i)) > 0 Then
        
       selection.collapse wdCollapseEnd
        Exit For
        End If
        Next i
        selection.Style = ActiveDocument.Styles("_4_text_citation")
         selection.collapse wdCollapseEnd
        End If
        Loop
    End With
    
    
    
    
    selection.HomeKey wdStory
        With selection.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Highlight = False
        .Text = " [A-Z][a-z]{1,}??[a-z]{1,} [0-9]{4}" '一个作者
        .Replacement.Text = ""
        .Forward = True
        .Highlight = False
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
        Do
        .Execute
        If Not .Found Then
        Exit Do
        End If
        If .Found And selection.Style <> ActiveDocument.Styles("_4_text_citation") Then
        
         If InputBox("Is this a reference call-out?", "Possible Reference Call-out Detected", "yes", 300, 300) = "yes" Then
        selection.Style = ActiveDocument.Styles("_4_text_citation")
         selection.collapse wdCollapseEnd
        End If
        End If
        Loop
    End With
    
    
    
        
    selection.HomeKey wdStory
        With selection.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Highlight = False
        .Text = " [A-Z][a-z]{1,} [0-9]{4}"                     ' 一个作者
        .Replacement.Text = ""
        .Forward = True
        .Highlight = False
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
        Do
        .Execute
        If Not .Found Then
        Exit Do
        End If
        If .Found And selection.Style <> ActiveDocument.Styles("_4_text_citation") Then
        
         If InputBox("Is this a reference call-out?", "Possible Reference Call-out Detected", "yes", 300, 300) = "yes" Then
        selection.Style = ActiveDocument.Styles("_4_text_citation")
         selection.collapse wdCollapseEnd
        End If
        End If
        Loop
    End With
    
        selection.HomeKey wdStory
        With selection.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Highlight = False
        .Text = " [A-Z][a-z]{1,}??[a-z]{1,} and [A-Z]* [0-9]{4}"                     ' 两个作者
        .Replacement.Text = ""
        .Forward = True
        .Highlight = False
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
        Do
        .Execute
        If Not .Found Then
        Exit Do
        End If
        If .Found And selection.Style <> ActiveDocument.Styles("_4_text_citation") Then
        
         If InputBox("Is this a reference call-out?", "Possible Reference Call-out Detected", "yes", 300, 300) = "yes" Then
        selection.Style = ActiveDocument.Styles("_4_text_citation")
         selection.collapse wdCollapseEnd
        End If
        End If
        Loop
    End With
    
    
    
        selection.HomeKey wdStory
        With selection.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Highlight = False
        .Text = " [A-Z][a-z]{1,}??[a-z]{1,} and [A-Z][a-z]{1,}??[a-z]{1,} [0-9]{4}"                     ' 两个作者
        .Replacement.Text = ""
        .Forward = True
        .Highlight = False
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
        Do
        .Execute
        If Not .Found Then
        Exit Do
        End If
        If .Found And selection.Style <> ActiveDocument.Styles("_4_text_citation") Then
        
         If InputBox("Is this a reference call-out?", "Possible Reference Call-out Detected", "yes", 300, 300) = "yes" Then
        selection.Style = ActiveDocument.Styles("_4_text_citation")
         selection.collapse wdCollapseEnd
        End If
        End If
        Loop
    End With
    
    
    
    
    
         selection.HomeKey wdStory
        With selection.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Highlight = False
        .Text = " [A-Z][a-z]{1,} and [A-Z][a-z]{1,}??[a-z]{1,} [0-9]{4}"                     ' 两个作者
        .Replacement.Text = ""
        .Forward = True
        .Highlight = False
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
        Do
        .Execute
        If Not .Found Then
        Exit Do
        End If
        If .Found And selection.Style <> ActiveDocument.Styles("_4_text_citation") Then
        
         If InputBox("Is this a reference call-out?", "Possible Reference Call-out Detected", "yes", 300, 300) = "yes" Then
        selection.Style = ActiveDocument.Styles("_4_text_citation")
         selection.collapse wdCollapseEnd
        End If
        End If
        Loop
    End With
    
    
    
    
    
    
       selection.HomeKey wdStory
        With selection.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Highlight = False
        .Text = " [A-Z][a-z]{1,} and [A-Z][a-z]{1,} [0-9]{4}"                     ' 两个作者
        .Replacement.Text = ""
        .Forward = True
        .Highlight = False
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
        Do
        .Execute
        If Not .Found Then
        Exit Do
        End If
        If .Found And selection.Style <> ActiveDocument.Styles("_4_text_citation") Then
        
         If InputBox("Is this a reference call-out?", "Possible Reference Call-out Detected", "yes", 300, 300) = "yes" Then
        selection.Style = ActiveDocument.Styles("_4_text_citation")
         selection.collapse wdCollapseEnd
        End If
        End If
        Loop
    End With
    
    
    
           selection.HomeKey wdStory
        With selection.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Highlight = False
        .Text = " [A-Z][a-z]{1,} et al. [0-9]{4}"                     ' 三个作者
        .Replacement.Text = ""
        .Forward = True
        .Highlight = False
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
        Do
        .Execute
        If Not .Found Then
        Exit Do
        End If
        If .Found And selection.Style <> ActiveDocument.Styles("_4_text_citation") Then
        
         If InputBox("Is this a reference call-out?", "Possible Reference Call-out Detected", "yes", 300, 300) = "yes" Then
        selection.Style = ActiveDocument.Styles("_4_text_citation")
         selection.collapse wdCollapseEnd
        End If
        End If
        Loop
    End With
    
    
'
Dim AuthorR As Range

  selection.HomeKey wdStory
        With selection.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Highlight = False
        .Text = " by [!0-9\(\)\,]@ \([0-9]{4}\)" '一个作者
        .Replacement.Text = ""
        .Forward = True
        .Highlight = False
        .Wrap = wdFindStop
        .Format = True
        .MatchWildcards = True
        Do
        .Execute
        If Not .Found Then
        Exit Do
        End If
        If .Found And selection.Style <> ActiveDocument.Styles("_4_text_citation") Then
        selection.Range.Select
        Set AuthorR = selection.Range
        AuthorR.Select
        AuthorR.SetRange selection.Range.Start + 4, selection.Range.End
         
         AuthorR.Select
         If InputBox("Is this a reference call-out?", "Possible Reference Call-out Detected", "yes", 300, 300) = "yes" Then
        
         
        AuthorR.Style = ActiveDocument.Styles("_4_text_citation")
           selection.collapse wdCollapseEnd
         Else
         selection.collapse wdCollapseEnd
        End If
        End If
        Loop
    End With '
    
    
    
    '
Dim AuthorR1 As Range

  selection.HomeKey wdStory
        With selection.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Highlight = False
        .Text = " of [!0-9\(\)\,]@ \([0-9]{4}\)" '一个作者
        .Replacement.Text = ""
        .Forward = True
        .Highlight = False
        .Wrap = wdFindStop
        .Format = True
        .MatchWildcards = True
        Do
        .Execute
        If Not .Found Then
        Exit Do
        End If
        If .Found And selection.Style <> ActiveDocument.Styles("_4_text_citation") Then
        selection.Range.Select
        Set AuthorR1 = selection.Range
        AuthorR1.Select
        AuthorR1.SetRange selection.Range.Start + 4, selection.Range.End
         
         AuthorR1.Select
         If InputBox("Is this a reference call-out?", "Possible Reference Call-out Detected", "yes", 300, 300) = "yes" Then
        
         
        AuthorR1.Style = ActiveDocument.Styles("_4_text_citation")
           selection.collapse wdCollapseEnd
         Else
         selection.collapse wdCollapseEnd
        End If
        End If
        Loop
    End With '
    
    
    
    Dim AuthorR2 As Range

  selection.HomeKey wdStory
        With selection.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Highlight = False
        .Text = " the [!0-9\(\)\,]@ \([0-9]{4}\)" '一个作者
        .Replacement.Text = ""
        .Forward = True
        .Highlight = False
        .Wrap = wdFindStop
        .Format = True
        .MatchWildcards = True
        Do
        .Execute
        If Not .Found Then
        Exit Do
        End If
        If .Found And selection.Style <> ActiveDocument.Styles("_4_text_citation") Then
        selection.Range.Select
        Set AuthorR2 = selection.Range
        AuthorR2.Select
        AuthorR2.SetRange selection.Range.Start + 5, selection.Range.End
         
         AuthorR2.Select
         If InputBox("Is this a reference call-out?", "Possible Reference Call-out Detected", "yes", 300, 300) = "yes" Then
        
         
        AuthorR2.Style = ActiveDocument.Styles("_4_text_citation")
           selection.collapse wdCollapseEnd
         Else
         selection.collapse wdCollapseEnd
        End If
        End If
        Loop
    End With '
    
    selection.HomeKey wdStory
    selection.Find.ClearFormatting
    selection.Find.Replacement.ClearFormatting
    selection.Find.Replacement.Font.Color = wdColorRed
    With selection.Find
        .Text = "\([1-9][0-9][0-9][0-9]"              '红色高亮四位数
        .Replacement.Text = ""
        .Forward = True
        .Highlight = False
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = True
        .MatchWholeWord = False
        .MatchByte = False
        .MatchWildcards = True
        .MatchSoundsLike = False
        .MatchAllWordForms = False
        Do
        .Execute
        If Not .Found Then
        Exit Do
        End If
        If .Found And selection.Style <> ActiveDocument.Styles("_4_text_citation") Then
        selection.Style = ActiveDocument.Styles("_4_text_citation")
        selection.collapse wdCollapseEnd
        End If
        Loop
    End With
    
    
    
      Call word2html.forthcoming_highlight
        
        Call word2html.n_d_highlight
    
        selection.HomeKey wdStory
    '.Close True
    End With
End Sub
Sub comments(ByVal control As IRibbonControl)
Select Case control.ID
Case "Chicago_deck_comment"
selection.Range.HighlightColorIndex = wdYellow
selection.comments.Add Range:=selection.Range, Text:=""
ActiveWindow.View.ShowRevisionsAndComments = True

Case "Chicago_comments_1"
selection.Range.HighlightColorIndex = wdYellow
selection.comments.Add Range:=selection.Range, Text:="Is it reference citation? if so, please add reference information in reference list. "
ActiveWindow.View.ShowRevisionsAndComments = True


Case "Chicago_comments_2"
selection.Range.HighlightColorIndex = wdYellow
selection.comments.Add Range:=selection.Range, Text:="This reference has not been cited in the main text, please add  citation in the main text, or delete this reference. "
ActiveWindow.View.ShowRevisionsAndComments = True


Case "Chicago_comments_3"
selection.Range.HighlightColorIndex = wdYellow
selection.comments.Add Range:=selection.Range, Text:="The citation year is different from the one in reference list, please confirm which is correct. "
ActiveWindow.View.ShowRevisionsAndComments = True

Case "Chicago_comments_4"
selection.Range.HighlightColorIndex = wdYellow
selection.comments.Add Range:=selection.Range, Text:="Please check the accuracy of it, if any problem, please modify."
ActiveWindow.View.ShowRevisionsAndComments = True

End Select
End Sub
Sub jia_and()
Call layout_search_replace.jump_to_reference_section
Dim myrange As Range
Set myrange = ActiveDocument.Range(Start:=selection.Range.Start, End:=ActiveDocument.Range.End)
With myrange.Find
    .Text = "&"
    .Replacement.Text = "and"
    .MatchWildcards = False
    .Wrap = wdFindStop
    .Forward = True
    
    .Execute Replace:=wdReplaceAll
End With
End Sub