Option Explicit
Dim cmdBar1 As CommandBar, cmdBar2 As CommandBar
Sub MakeMenu()
  Dim cmdBar As CommandBar
  For Each cmdBar In Application.CommandBars
     If cmdBar.Name = "Cell" Then
       If cmdBar1 Is Nothing Then
         Set cmdBar1 = cmdBar
         MakeMenu_2 cmdBar
       Else
         Set cmdBar2 = cmdBar
         MakeMenu_2 cmdBar
         Exit For
       End If
     End If
  Next cmdBar
End Sub

Sub MakeMenu_2(ByVal cmdBar)
'   Добавление пунктов контекстного меню
    Dim Cap(1 To 15)
    Dim Mac(1 To 15)
    Dim NewMenu As CommandBarControl
    Dim Item As CommandBarControl
    Dim MenuCount As Integer
    Dim i As Integer
    
    Cap(1) = "Выделить вверх (клавиши <Ctrl+Shift+Down>)"
    Mac(1) = "SelectDown"
    Cap(2) = "Выделить вверх (клавиши <Ctrl+Shift+Up>)"
    Mac(2) = "SelectUp"
    Cap(3) = "Выделить вправо (клавиши <Ctrl+Shift+Right>)"
    Mac(3) = " SelectToRight"
    Cap(4) = "Выделить влево (клавиши <Ctrl+Shift+Left>)"
    Mac(4) = " SelectToLeft"
    Cap(5) = "Выделить текущий регион (клавиши <Ctrl+Shift+*>)"
    Mac(5) = " SelectCurrentRegion"
    Cap(6) = "Выделить активную область (клавиши End, Home, <Ctrl+Shift+Home>)"
    Mac(6) = " SelectActiveArea"
    Cap(7) = "Выделить ячейки, смежные со столбцом с активной ячейкой"
    Mac(7) = " SelectActiveColumn"
    Cap(8) = "Выделить ячейки, смежные со строкой с активной ячейкой"
    Mac(8) = " SelectActiveRow"
    Cap(9) = "Выделить весь столбец (клавиши <Ctrl+пробел>)"
    Mac(9) = " SelectEntireColumn"
    Cap(10) = "Выделить всю строку  (клавиши <Shift+пробел>)"
    Mac(10) = " SelectEntireRow"
    Cap(11) = "Выделить весь лист (клавиши <Ctrl+A>)"
    Mac(11) = " SelectEntireSheet"
    Cap(12) = "Активизировать следующую пустую ячейку снизу"
    Mac(12) = " ActivateNextBlankDown"
    Cap(13) = "Активизировать следуущую пустую ячейку справа"
    Mac(13) = " ActivateNextBlankToRight"
    Cap(14) = "Выделить диапазон строки от первой непустой ячейки до последней непустой ячейки"
    Mac(14) = " SelectFirstToLastInRow"
    Cap(15) = "Выделить диапазон столбца от первой непустой ячейки до последней непустой ячейки"
    Mac(15) = " SelectFirstToLastInColumn"


'   Удалить меню, если оно уже существует
    On Error Resume Next
    cmdBar.Controls("&Демонстрация выделения").Delete
    On Error GoTo 0
    
'   Добавление меню
    MenuCount = cmdBar.Controls.Count
    Set NewMenu = cmdBar.Controls.Add(Type:=msoControlPopup, temporary:=True)
    NewMenu.Caption = "&Демонстрация выделения"
    
'   Добавление пунктов меню
    For i = 1 To 15
        Set Item = NewMenu.Controls.Add(Type:=msocontrolbutton, temporary:=True)
        With Item
            .Caption = Cap(i)
            .OnAction = Mac(i)
            If i Mod 4 = 0 Then .BeginGroup = True
        End With
    Next i
End Sub

Sub DeleteMenu()
'   Удаление меню перед закрытием
    On Error Resume Next
    cmdBar1.Controls("&Демонстрация выделения").Delete
    cmdBar2.Controls("&Демонстрация выделения").Delete
End Sub