Добавление в контекстное меню кнопок по выполнению макросов

Sub newItemToContextMenu()
'Добавляем новую команду (пункт меню) в контекстное меню, вызываемое по щелчку правой кнопкой мыши
Dim cb As CommandBar  'Объявляем переменные
Dim cbb As CommandBarButton
Dim cbc As CommandBarControl
CustomizationContext = NormalTemplate  'Сохраняем изменения настроек в глобальном шаблоне Normal.dotm
On Error GoTo Ex  'В случае ошибки переходим к метке
Set cb = CommandBars("text")  'Определяем конкретную панель (меню), куда будем вставлять нашу команду
Set cbb = cb.FindControl(ID:=755)  'Определяем ссылку на конкретный пункт (кнопку) меню для возможностей дальнейшего поиска этого элемента
If Not cbb Is Nothing Then Exit Sub 'Если пункт меню уже существует, то происходит выход из макроса без действий
Set cbb = cb.Controls.Add(Type:=msoControlButton, ID:=755, Parameter:="new", Before:=1, Temporary:=False)   'Создаем пункт меню "Специальная вставка"
Set cbb = Nothing 'Освобождаем переменную и память 
Ex: 'метка для ошибки
End Sub

Dim мое_место As Variant
Dim nameMacro As Variant
 
 
 
 
Private Sub Document_Open() 'создание кнопок меню (правая кнопка мыши)
    With Application.CommandBars("Text")
         .Reset
         For Each nameMacro In Array("Переход", "Выделен_Тхт")
             With .Controls.Add
                  .Caption = nameMacro
                  .OnAction = nameMacro
             End With
         Next
         .ShowPopup 'Проверка
    End With
мое_место = 0
End Sub
 
Sub Выделен_Тхт()
 
If (Selection.Type <> wdSelectionIP) Then
   какая_кн_нажата = InputBox("искать информацию " & Selection.Text & " в интернете?" & Chr(13) & _
" 1-е-лайбрари" & Chr(13) & _
" 2-диссертации" & Chr(13) & _
" 3-не искать")
Else
   MsgBox "Выдели текст"
End If
 
Select Case какая_кн_нажата
Case 1
 
какая_кн_нажата = "https://ya.ru/search/?text=" & "site:[url]www.elibrary.ru[/url] " & Selection.Text
ActiveDocument.FollowHyperlink Address:=какая_кн_нажата, NewWindow:=True, AddHistory:=True
 
Case 2
 
какая_кн_нажата = "https://ya.ru/search/?text=" & "site:[url]www.dissercat.com[/url] " & Selection.Text
ActiveDocument.FollowHyperlink Address:=какая_кн_нажата, NewWindow:=True, AddHistory:=True
 
Case 3
    
Case Else
 
End Select
End Sub
 
 
 
Sub Переход()
'проверка наличия метки для литературы или другого места (№2)
    If Bookmarks.Exists("где_я2") = False Then
ActiveDocument.Bookmarks.Add Name:="где_я1"
    'создаю метки // иначе будет таскать
    стр = InputBox("на какую страницу перейти?")
'переходим на ...-ю страницу и 3-ю строку в ней
ActiveDocument.Range.GoTo(What:=wdGoToPage, Which:=wdGoToAbsolute, Count:=стр).GoTo(What:=wdGoToLine, Which:=wdGoToRelative, Count:=3).Select
'переходим к 1-му символу
Selection.Move Unit:=wdCharacter, Count:=1
    ActiveDocument.Bookmarks.Add Name:="где_я2"
GoTo 100
End If
 
' - ставлю флажок
If мое_место = 1 Then
    ActiveDocument.Bookmarks.Add Name:="где_я1"         'запоминаю где Я
    Selection.GoTo What:=wdGoToBookmark, Name:="где_я2" 'перехожу
    мое_место = 0
    Else
    ActiveDocument.Bookmarks.Add Name:="где_я2"
    Selection.GoTo What:=wdGoToBookmark, Name:="где_я1"
    мое_место = 1
End If
 
100
End Sub

Sub ПеречислениеКонтекстМеню()
    Dim cb As CommandBar
    With CreateObject("Scripting.Dictionary")
      For Each cb In CommandBars
          If cb.Type = msoBarTypePopup Then
              If Not .Exists(cb.Name) Then
                  .Add cb.Name, Empty
                  Debug.Print cb.NameLocal & vbCr & vbTab & cb.Name
              End If
          End If
      Next
    End With
End Sub