Sub MacrosAllRestoreMac()
' Paul Beverley - Version 03.02.18
' Adds keybindings from a list of macro names

' Keybindings start

' Keybindings end
Selection.HomeKey Unit:=wdStory
With Selection.Find
  .ClearFormatting
  .Replacement.ClearFormatting
  .Text = "Sub Macros" & "AllRestore()"
  .MatchCase = False
  .MatchWildcards = False
  .Execute
End With
If Selection.Find.Found = False Then
  MsgBox "Can't find Sub MacrosAllRestore" & vbCr & vbCr _
       & "Is this a macro backup file?"
  Exit Sub
End If

Selection.Collapse wdCollapseEnd
With Selection.Find
  .Text = "Keybind" & "ings start"
  .Execute
End With

Selection.Expand wdParagraph
Selection.Collapse wdCollapseEnd
bindersStart = Selection.Start
With Selection.Find
  .Text = "Keybind" & "ings end"
  .Execute
End With
Selection.Expand wdParagraph
Selection.Collapse wdCollapseStart
Selection.MoveEnd , -1
Selection.Start = bindersStart

numKeys = 0
Set myList = Selection.range.Duplicate

For Each myPara In myList.Paragraphs
  myLine = myPara.range.Text
  myLine = Replace(myLine, vbCr, "")
  If Len(myLine) > 1 And InStr(myLine, ":") > 0 Then
    colonPos = InStr(myLine, ":")
    myMacroName = Trim(Mid(myLine, 2, colonPos - 2))
    ks = Mid(myLine, colonPos + 3)
    kCode = 0
    If InStr(ks, "Command+") > 0 Then
      kCode = kCode + 256
      ks = Replace(ks, "Command+", "")
    End If
    If InStr(ks, "Control+") > 0 Then
      kCode = kCode + 4096
      ks = Replace(ks, "Control+", "")
    End If
    If InStr(ks, "Option+") > 0 Then
      kCode = kCode + 2048
      ks = Replace(ks, "Option+", "")
    End If
    If InStr(ks, "Shift+") > 0 Then
      kCode = kCode + 512
      ks = Replace(ks, "Shift+", "")
    End If
    
    ' Ordinary capital letters
    If ks Like "[A-Z]" Then
      aCode = Asc(UCase(ks))
      ks = ""
    End If
    
    ' Ordinary numbers
    If ks Like "[0-9]" Then
      aCode = Asc(UCase(ks))
      ks = ""
    End If
    
    ' F keys
    If Left(ks, 1) = "F" And Len(ks) > 1 Then
      aCode = 111 + Val(Replace(ks, "F", ""))
      ks = ""
    End If
    
    Select Case ks
      Case "!": aCode = wdKey1: kCode = kCode + 256 ' Shifted number 1
      Case """": aCode = wdKey2: kCode = kCode + 256 ' Shifted number 2
      Case ChrW(163): aCode = wdKey3: kCode = kCode + 256 ' Shifted number 3
      Case "$": aCode = wdKey4: kCode = kCode + 256 ' Shifted number 4
      Case "%": aCode = wdKey5: kCode = kCode + 256 ' Shifted number 5
      Case "^": aCode = wdKey6: kCode = kCode + 256 ' Shifted number 6
      Case "&": aCode = wdKey7: kCode = kCode + 256 ' Shifted number 7
      Case "*": aCode = wdKey8: kCode = kCode + 256 ' Shifted number 8
      Case "(": aCode = wdKey9: kCode = kCode + 256 ' Shifted number 9
      Case ")": aCode = wdKey0: kCode = kCode + 256 ' Shifted number 0
      Case "'": aCode = 192
      Case "-": aCode = wdKeyHyphen ' The - key
      Case "#": aCode = 222
      Case ",": aCode = wdKeyComma ' The , key
      Case ".": aCode = wdKeyPeriod ' The  key
      Case "/": aCode = wdKeySlash
      Case ":": aCode = wdKeySemiColon: kCode = kCode + 256
      Case ";": aCode = wdKeySemiColon ' The ; key
      Case "?": aCode = wdKeySlash: kCode = kCode + 256
      Case "@": aCode = 192: kCode = kCode + 256
      Case "[": aCode = wdKeyOpenSquareBrace ' The ] key
      Case "\": aCode = wdKeyBackSlash ' The \ key
      Case "]": aCode = wdKeyCloseSquareBrace ' The ] key
      Case "_": aCode = wdKeyHyphen ' Does it need? kCode = kCode + 256
      Case "`": aCode = 223
      Case "{": aCode = wdKeyOpenSquareBrace: kCode = kCode + 256
      Case "}": aCode = wdKeyCloseSquareBrace: kCode = kCode + 256
      Case "~": aCode = 222: kCode = kCode + 256
      Case "+": aCode = wdKeyEquals ' kCode = kCode + 256
      Case "<": aCode = wdKeyComma: kCode = kCode + 256
      Case "=": aCode = wdKeyEquals ' The = key
      Case ">": aCode = wdKeyPeriod: kCode = kCode + 256
      Case "Backspace": aCode = wdKeyBackspace ' The Backspace key
      Case "Clear (Num 5)": aCode = wdKeyNumeric5: kCode = kCode + 256
      Case "Delete": aCode = wdKeyDelete ' The Delete key
      Case "Down": aCode = 40 ' The Down Cursor key
      Case "End": aCode = 35 ' The EndD key
      Case "Home": aCode = wdKeyHome ' The HOME key
      Case "Insert": aCode = wdKeyInsert ' The Insert key
      Case "Left": aCode = 37 ' The Left Cursor key
      Case "Num -": aCode = wdKeyNumericSubtract ' The - key on the keypad
      Case "Num *": aCode = wdKeyNumericMultiply ' The * key on the keypad
      Case "Num /": aCode = wdKeyNumericDivide ' The / key on the keypad
      Case "Num +": aCode = wdKeyNumericAdd ' The + key on the keypad
      Case "Num 0": aCode = wdKeyNumeric0 ' The 0 key on the keypad
      Case "Num 1": aCode = wdKeyNumeric1 ' The 1 key on the keypad
      Case "Num 2": aCode = wdKeyNumeric2 ' The 2 key on the keypad
      Case "Num 3": aCode = wdKeyNumeric3 ' The 3 key on the keypad
      Case "Num 4": aCode = wdKeyNumeric4 ' The 4 key on the keypad
      Case "Num 5": aCode = wdKeyNumeric5 ' The 5 key on the keypad
      Case "Num 6": aCode = wdKeyNumeric6 ' The 6 key on the keypad
      Case "Num 7": aCode = wdKeyNumeric7 ' The 7 key on the keypad
      Case "Num 8": aCode = wdKeyNumeric8 ' The 8 key on the keypad
      Case "Num 9": aCode = wdKeyNumeric9 ' The 9 key on the keypad
      Case "Page Down": aCode = 34 ' The Page Down key
      Case "Page Up": aCode = 33 ' The Page Up key
      Case "Return": aCode = wdKeyReturn ' The Enter or Return key
      Case "Right": aCode = 39 ' The Right Cursor key
      Case "Space": aCode = wdKeySpacebar ' The Spacebar key
      Case "Up": aCode = 38 ' The Up Cursor key
    End Select
    
    kCode = kCode + aCode
    hexCode = Replace(Hex(kCode), "FFFF", "")

    KeyBindings.Add KeyCode:=kCode, _
         KeyCategory:=wdKeyCategoryMacro, Command:=myMacroName
    numKS = numKS + 1
  End If
Next myPara
MsgBox ("Restored: " & numKS & " macro key assignments")
End Sub