Option Explicit

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    Call b(Sh, Selection)
End Sub
Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
    Call a
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    Call b(Sh, Target)
End Sub
Private Sub Workbook_WindowActivate(ByVal Wn As Window)
     Call b(ActiveSheet, Selection)
End Sub
Private Sub Workbook_WindowDeactivate(ByVal Wn As Window)
    Call a
End Sub
Private Sub a()
    Dim s, k
    For Each s In Array("", "^")
        For Each k In Array(107, 109, "+", "-")
            Application.OnKey s & "{" & k & "}"
    Next k, s
End Sub
Private Sub b(ByVal Sh As Object, ByVal Target As Range)
    Const addr$ = "B1:B100"
    Call a
    If Not Sh Is Лист1 Then Exit Sub
    If Intersect(Target, Sh.Range(addr)) Is Nothing Then Exit Sub
    Dim s, k, i%
    For Each s In Array("", "^")
        For Each k In Array(107, 109, "+", "-")
            Application.OnKey s & "{" & k & "}", "'" & Me.CodeName & ".c """ & _
                              IIf(i Mod 2, "-", "") & IIf(s > "", [A2], [A1]).Formula & _
                              """, [" & addr & "]'"
            i = i + 1
    Next k, s
End Sub
Sub c(n, ByRef r As Range)
    With Intersect(Selection, r)
        .Value = Evaluate(.Address(, , Application.ReferenceStyle) & "+" & n)
    End With
End Sub

 On Error Resume Next
    With ActiveSheet.Shapes(Application.Caller).TopLeftCell.Previous
        .Value = .Value + 1
    End With