Cacher is the code snippet organizer for pro developers

Dim aimT As String
    Dim arr() As String
    Call kr_deck.aselect_whole_reference
    Dim wholeRef As String
    wholeRef = Selection.Range.Text
    Dim i As Integer
    i = 401
    arr = Split(wholeRef, ChrW(13))
    Selection.HomeKey wdStory
 Do
 If i = 508 Then
 Exit Do
 End If
    With Selection.Find
        .Text = CStr(i)
        .Wrap = wdFindStop
        .Forward = True
        .MatchWholeWord = True
        .Highlight = True
       
        .Execute
            If .Found Then
            With Selection
                        With .FootnoteOptions
                            .Location = wdBottomOfPage
                            .NumberingRule = wdRestartContinuous
                            .StartingNumber = 1
                            .NumberStyle = wdNoteNumberStyleArabic
                            
                        End With
                        .Footnotes.Add Range:=Selection.Range, Text:=arr(CInt(Selection.Text) - 1)
        
                End With
            
            End If
        End With
        i = i + 1
        Selection.MoveRight wdCharacter, 1
 Loop
    
    
    
    Sub q()
Dim aimT As String
    Dim arr() As String
    Call kr_deck.aselect_whole_reference
    Dim wholeRef As String
    wholeRef = Selection.Range.Text
    Dim i As Integer
    i = 507
    arr = Split(wholeRef, ChrW(13))
    Selection.HomeKey wdStory
 Do
 If i = 508 Then
 Exit Do
 End If
    With Selection.Find
        .Text = CStr(i)
        .Wrap = wdFindStop
        .Forward = True
        .MatchWholeWord = True
        .Highlight = True
       
        .Execute
            If .Found Then
            With Selection
                        With .FootnoteOptions
                            .Location = wdBottomOfPage
                            .NumberingRule = wdRestartContinuous
                            .StartingNumber = 1
                            .NumberStyle = wdNoteNumberStyleArabic
                            
                        End With
                        .Footnotes.Add Range:=Selection.Range, Text:=arr(CInt(Selection.Text) - 1)
        Selection.Range.Delete
                End With
            
            End If
        End With
        i = i + 1
        Selection.MoveRight wdCharacter, 1
 Loop
    
    
End Sub

Sub FormatYearVolPage_Alltt()
    

    Application.ScreenUpdating = False

    Dim strtemp, year, vol, page As String
    Dim arr() As String
    Dim count, n As Long
    count = 0
    Dim myrange As Range
ActiveDocument.StoryRanges(wdEndnotesStory).Select
Set myrange = ActiveDocument.StoryRanges(wdEndnotesStory)

With Selection.Find
  .Text = "[a-z]. [A-Za-z]{1,}[!^13,]@[0-9]{4}"
  .MatchWildcards = True
  Do
  .Execute
  If Not .Found Then
  Exit Do
  Else
  Selection.Collapse wdCollapseStart
 Selection.MoveRight wdCharacter, 2
 Selection.MoveEndUntil ("0123456789")
           

  Selection.Range.Italic = -1

 
 Selection.Collapse wdCollapseEnd
  End If
  Loop
End With
    'MsgBox "Totally replace " & count & " times", vbInformation
    Erase arr

    ActiveWindow.View.ShowRevisionsAndComments = True
End Sub

Sub HighlightAndExpand()



    ActiveWindow.View.ShowRevisionsAndComments = False
    ActiveWindow.View.ShowFieldCodes = False
    Selection.HomeKey wdStory
    With Selection.Find
        .ClearFormatting
    
        .Text = "["
        .Replacement.Text = ""
        .MatchWildcards = False
        .Wrap = wdFindContinue
        Do
            .Execute
            If .Found Then
                Selection.MoveEndWhile ("0123456789," & ChrW(8211))
                If Selection.Next(wdCharacter, 1) = "]" And Selection.Characters.count > 1 Then
                    Selection.MoveEnd wdCharacter, 1
                       
                        Selection.Text = ExpandRefNum(Selection.Text)
                        Selection.Range.HighlightColorIndex = wdYellow
                End If
                Selection.Collapse wdCollapseEnd
            Else
                Exit Do
            End If
        Loop
    End With
    MsgBox "Call-out expansion complete.", vbInformation
End Sub
Sub Macro1()
'
' Macro1 Macro
'
'
End Sub
Sub 给没有reference的加链接()

 With Selection.Find
        .Text = "[0-9]{1,}"
        .Wrap = wdFindStop
        .Forward = True
        .MatchWildcards = True
        .MatchWholeWord = True
        .Highlight = True
       Do
        .Execute
        If Not .Found Then
        Exit Do
        Else
               Selection.InsertCrossReference ReferenceType:="Endnote", _
               ReferenceKind:=wdEndnoteNumber, _
               ReferenceItem:=Selection.Range.Text, InsertAsHyperlink:=True, _
               IncludePosition:=False, SeparateNumbers:=False, SeparatorString:=" "
            End If
            Loop
End With
'
 
End Sub
Sub 给comment加高亮()
Dim a As Comment
For Each a In ActiveDocument.comments
    a.Scope.HighlightColorIndex = wdYellow
Next
End Sub
Sub FormatYearVolPage_All()
    ActiveDocument.StoryRanges(wdEndnotesStory).Select

    Dim strtemp, year, vol, page As String
    Dim arr() As String
    Dim count, n As Long
    count = 0

    With Selection.Find
        .ClearFormatting
        .Text = "<[0-9]{4}>\, <[0-9]@>\, <[0-9\-^=]@>"    'can tweak further to consider the pagination en-dash or hyphen, or where the pagintion contains colon 1:123-1:456, or when the space between year/volumn is optional ^32{0,}. the last \-^= will not be taken as part of the word
        .Replacement.ClearFormatting
        .Replacement.Text = ""
        .MatchWildcards = True
        .Forward = True
        .Execute Wrap:=wdFindStop
    End With

    Do While Selection.Find.Found
        With Selection.Font
            .Bold = False
            .Italic = False
        End With
        strtemp = Selection.Text
        arr = Split(strtemp, ",")
        year = Trim(arr(0))
        vol = Trim(arr(1))
        page = Trim(arr(2))

        With Selection.Font
            .Bold = False
            .Italic = False
        End With
        With Selection
            .Font.Bold = wdToggle
            .TypeText (year)
            .Font.Bold = wdToggle
            .TypeText (", ")
            .Font.Italic = wdToggle
            .TypeText (vol)
            .Font.Italic = wdToggle
            .TypeText (", " & page)
        End With

        count = count + 1
        Selection.Find.Execute
    Loop
    'MsgBox "Totally replace " & count & " times", vbInformation
    Erase arr

    ActiveWindow.View.ShowRevisionsAndComments = True
End Sub