Developing.ru

Код: Выделить всё

Private Sub UserForm_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    If Button = 2 Then СозданиеМеню_ЗаполнениеЭтогоМенюЭлементами_и_ЕгоОтображение
End Sub

Код: Выделить всё

Sub [B]СозданиеМеню_ЗаполнениеЭтогоМенюЭлементами_и_ЕгоОтображение[/B]()
    On Error Resume Next: Application.CommandBars.Add "Моё контекстное меню", msoBarPopup
    
    Dim p As CommandBar: Set p = Application.CommandBars("Моё контекстное меню")
    'p.Reset - почему-то не работает ' очистка меню от прежних пунктов (если каждый раз добавляем разные пункты)
    For Each ctrl In p.Controls: ctrl.Delete: Next    ' а вот так пункты меню удаляются


    AddItemIntoPopup p, 1, 161, "Make_Netflow_Report", "Обработка результатов запроса"
    AddItemIntoPopup p, 4, -1, "SearchNumber", "Поиск номеров"


    Set NewMenu = p.Controls.Add(Type:=msoControlPopup)    ' подменю Additional Tools
    With NewMenu: .Caption = "&Additional Tools": .BeginGroup = True: End With

    AddItemIntoPopup NewMenu, 1, IIf(DemoMode, 232, 231), "ToggleDemoMode", IIf(DemoMode, "В&ыключить безопасный режим", "&Включить безопасный режим"), True, "Demo3"
    AddItemIntoPopup NewMenu, 1, 3, "Save_AddIn_Copy_in_Settings", "Сохранить копию программы в папке Settings", True
    AddItemIntoPopup NewMenu, 1, 749, "Save_AddIn_Copy", "Сохранить копию программы с указанием даты и времени"
    AddItemIntoPopup NewMenu, 1, 2936, "PrepareAddInForUpdate", "Создать файл обновления", False
    AddItemIntoPopup NewMenu, 1, 964, "Write_MainSettingsFile", "Перезаписать файл Main.ini", True
    AddItemIntoPopup NewMenu, 1, 161, "MakeSummaryPage", "Создание сводной таблицы", False

    AddItemIntoPopup NewMenu, 1, 3, "WriteDefaultRegistryValuesOnFirstRun", "Применить настройки по умолчанию", True
    AddItemIntoPopup p, 1, 1088, "SetIsAddinTrue", "Скрыть листы файла программы", True
    AddItemIntoPopup p, 1, 1087, "SetIsAddinFalse", "Отобразить листы файла программы", False
    AddItemIntoPopup p, 1, 1809, "Install_Update_Local", "Install_Update_Local", True

    p.ShowPopup
End Sub

[B]Function AddItemIntoPopup[/B](ByRef Comm_Bar, ByVal B_Type As Integer, ByVal B_Face As Integer, _
                          ByVal On_Action As String, ByVal B_Caption As String, Optional ByVal Begin_Group As Boolean = False, Optional Tag As String = "") As CommandBarControl
' добавляет контролы в меню Comm_Bar ' type=1 - это кнопка, type=4 - это комбобокс, 10 - popup
    On Error Resume Next
    Set Add_Control = Comm_Bar.Controls.Add(Type:=B_Type)
    With Add_Control
        If B_Face > 0 Then .FaceId = B_Face:
        .Tag = Tag: .OnAction = On_Action: .Caption = B_Caption: If Begin_Group Then .BeginGroup = True
        'If надо_сделать_пункт_недоступным Then .Enabled = False
    End With
End Function