Добавить Попап меню popUP

'Это кидаем на WorkBook
Private Sub Workbook_Open()
    Call AddToShortCut2
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Call ResetAllShortcutMenus 'DeleteFromShortcut
End Sub

'Это кидаем в Модуль
Option Explicit

Sub AddToShortCut2()
'   Adds a menu item to the Cell shortcut menu (all open workbook windows)
    Dim NewControl As CommandBarButton
    Dim NewContro2 As CommandBarButton
    Dim NewContro3 As CommandBarButton
    Dim activeWin As Window
    Dim w As Window
    
    Set activeWin = ActiveWindow
    Application.ScreenUpdating = False
   
'   Loop through each visible window
    For Each w In Windows
        If w.Visible Then
            w.Activate
'           Delete control if it already exists
            On Error Resume Next
            CommandBars("Cell").Controls("Перенос &по словам").Delete
            CommandBars("Cell").Controls("Найти компанию в выделенном").Delete
            CommandBars("Cell").Controls("Найти банки").Delete
            On Error GoTo 0
'           Add the new control
Set NewControl = CommandBars("Cell").Controls.Add _
                (Type:=msoControlButton, ID:=1)
            With NewControl
                .Caption = "Перенос &по словам"
                .OnAction = "ToggleWrapText"
                .FaceId = 320
                .Style = msoButtonIconAndCaption
            End With

'Найти компанию в выделенном
Set NewContro2 = CommandBars("Cell").Controls.Add _
                (Type:=msoControlButton, ID:=2)
    With NewContro2
        .Caption = "Найти компанию в выделенном"
        .OnAction = "ПолучитьКонтрагентовSELECT"
        .FaceId = 59
        .Style = msoButtonIconAndCaption
    End With

'Поиск банков
Set NewContro3 = CommandBars("Cell").Controls.Add _
                (Type:=msoControlButton, ID:=3)
    With NewContro3
        .Caption = "Найти банки"
        .OnAction = "ПолучитьКонтрагентовБанки"
        .FaceId = 384
        .Style = msoButtonIconAndCaption
    End With
    
    
        End If
    Next w
'   Activate original window
    activeWin.Activate
    Application.ScreenUpdating = True
End Sub

Sub ResetAllShortcutMenus()
'   Работает только в активном окне
    Dim cbar As CommandBar
    For Each cbar In Application.CommandBars
        If cbar.Type = msoBarTypePopup Then
            cbar.Reset
            cbar.Enabled = True
        End If
    Next cbar
End Sub