Emacs like key bindings for Microsoft Excel

EmacsMode.bas

'' define EmacsMode key bindings
Sub EmacsMode()
    With Application
        .OnKey "^{f}", "ForwardCell"
        .OnKey "^{b}", "BackwardCell"
        .OnKey "^{p}", "PreviousLine"
        .OnKey "^{n}", "NextLine"
        .OnKey "^{a}", "BeginningOfUsedRangeLine"
        .OnKey "^{e}", "EndOfUsedRangeLine"
        .OnKey "%{<}", "BeginningOfUsedRangeRow"
        .OnKey "%{>}", "EndOfUsedRangeRow"
        .OnKey "^{v}", "ScrollUp"
        .OnKey "^{z}", "ScrollDown"
        .OnKey "^{l}", "Recenter"
        .OnKey "^{s}", "Search"
        .OnKey "^{x}", "CxMode"
        .OnKey "+{ESC}", "Enable_Keys"
    End With
End Sub

'' define EmacsMode commands
' C-f 右のセルへ移動
Sub ForwardCell()
    If ActiveCell.MergeCells Then
        If ActiveCell.MergeArea.End(xlToRight).Column = Columns.Count Then Exit Sub
    End If
    If ActiveCell.Column <> Columns.Count Then ActiveCell.Offset(0, 1).Activate
End Sub
' C-b 左のセルへ移動
Sub BackwardCell()
    If ActiveCell.Column <> 1 Then ActiveCell.Offset(0, -1).Activate
End Sub
' C-p 上の行へ移動
Sub PreviousLine()
    If ActiveCell.Row <> 1 Then ActiveCell.Offset(-1, 0).Activate
End Sub
' C-n 下の行へ移動
Sub NextLine()
    If ActiveCell.MergeCells Then
        If ActiveCell.MergeArea.End(xlDown).Row = Rows.Count Then Exit Sub
    End If
    If ActiveCell.Row <> Rows.Count Then ActiveCell.Offset(1, 0).Activate
End Sub
' C-a UsedRangeの左端に移動
Sub BeginningOfUsedRangeLine()
    Cells(ActiveCell.Row, ActiveSheet.UsedRange.Column).Activate
End Sub
' C-e UsedRangeの右端に移動
Sub EndOfUsedRangeLine()
    Cells(ActiveCell.Row, _
        ActiveSheet.UsedRange.Columns _
        (ActiveSheet.UsedRange.Columns.Count).Column).Activate
End Sub
' M-< UsedRangeの先頭行へ移動
Sub BeginningOfUsedRangeRow()
    Cells(ActiveSheet.UsedRange.Row, ActiveCell.Column).Activate
End Sub
' M-> UsedRangeの最終行へ移動
Sub EndOfUsedRangeRow()
    Cells(ActiveSheet.UsedRange.Rows _
        (ActiveSheet.UsedRange.Rows.Count).Row, _
        ActiveCell.Column).Activate
End Sub
' C-v 1画面前進
Sub ScrollUp()
   Dim RowNum As Long
   Dim ColNum As Long
   With ActiveWindow
    RowNum = .ActiveCell.Row - .VisibleRange.Row + 1
    ColNum = .ActiveCell.Column
    .LargeScroll down:=1
    .VisibleRange.Cells(RowNum, ColNum).Activate
   End With
End Sub
' C-z 1画面後退
Sub ScrollDown()
   Dim RowNum As Long
   Dim ColNum As Long
   With ActiveWindow
    RowNum = .ActiveCell.Row - .VisibleRange.Row + 1
    ColNum = .ActiveCell.Column
    .LargeScroll up:=1
    .VisibleRange.Cells(RowNum, ColNum).Activate
   End With
End Sub
' C-l 現在行を画面の（だいたい）中央に
Sub Recenter()
    Dim x As Long
    With ActiveWindow
        x = Int(ActiveCell.Row - (.VisibleRange.Height / ActiveCell.Height) / 2.5)
        If x > 0 Then
            .ScrollRow = x
        End If
    End With
End Sub
 ' C-s 検索ダイアログ
 Sub Search()
    Application.Dialogs(xlDialogFormulaFind).Show
 End Sub


'' define C-x mode key bindings
Sub CxMode()
    With Application
        .OnKey "^{s}", "SaveFile"
        .OnKey "^{w}", "WriteFile"
        .OnKey "^{f}", "FindFile"
        .OnKey "^{p}", "PrintFile"
        .OnKey "^{g}", "EmacsMode"
        .OnKey "^{x}" ' cut
        .OnKey "^{v}" ' paste
        .OnKey "^{z}" ' undo
    End With
End Sub

'' define C-x mode commands
' C-x C-s 上書き保存
Sub SaveFile()
    ThisWorkbook.Save
    Call EmacsMode
End Sub
' C-x C-w 名前をつけて保存
Sub WriteFile()
    Application.Dialogs(xlDialogSaveAs).Show
    Call EmacsMode
End Sub
' C-x C-f ファイルを開く
Sub FindFile()
    Application.Dialogs(xlDialogOpen).Show
    Call EmacsMode
End Sub
' C-x C-p 印刷ダイアログ
Sub PrintFile()
    Application.Dialogs(xlDialogPrint).Show
    Call EmacsMode
End Sub


' http://www.rondebruin.nl/key.htm
Sub Enable_Keys()
    Dim StartKeyCombination As Variant
    Dim KeysArray As Variant
    Dim Key As Variant
    Dim I As Long

    On Error Resume Next

    'Shift key = "+"  (plus sign)
    'Ctrl key = "^"   (caret)
    'Alt key = "%"    (percent sign
    'We fill the array with this keys and the key combinations
    'Shift-Ctrl, Shift- Alt, Ctrl-Alt, Shift-Ctrl-Alt

    For Each StartKeyCombination In Array("+", "^", "%", "+^", "+%", "^%", "+^%")

        KeysArray = Array("{BS}", "{BREAK}", "{CAPSLOCK}", "{CLEAR}", "{DEL}", _
                    "{DOWN}", "{END}", "{ENTER}", "~", "{ESC}", "{HELP}", "{HOME}", _
                    "{INSERT}", "{LEFT}", "{NUMLOCK}", "{PGDN}", "{PGUP}", _
                    "{RETURN}", "{RIGHT}", "{SCROLLLOCK}", "{TAB}", "{UP}")

        'Enable the StartKeyCombination key(s) with every key in the KeysArray
        For Each Key In KeysArray
            Application.OnKey StartKeyCombination & Key
        Next Key

        'Enable the StartKeyCombination key(s) with every other key
        For I = 0 To 255
            Application.OnKey StartKeyCombination & Chr$(I)
        Next I

        'Enable the F1 - F15 keys in combination with the Shift, Ctrl or Alt key
        For I = 1 To 15
            Application.OnKey StartKeyCombination & "{F" & I & "}"
        Next I

    Next StartKeyCombination


    'Enable the F1 - F15 keys
    For I = 1 To 15
        Application.OnKey "{F" & I & "}"
    Next I

    'Enable the PGDN and PGUP keys
    Application.OnKey "{PGDN}"
    Application.OnKey "{PGUP}"
End Sub