VBA Excel. Создание контекстного меню для кнопки

Программное создание контекстного меню для кнопки ActiveX с помощью кода VBA Excel. Добавление кнопки на рабочий лист.

Содержание

Контекстное меню для кнопки

С помощью VBA Excel можно заставить кнопку запускать одну процедуру из нескольких на выбор, если создать для неё контекстное меню. Открывается контекстное меню кликом на объекте правой кнопкой мыши.

В этой статье разберём, как:

Программно добавить кнопку из коллекции элементов управления ActiveX на рабочий лист Excel.
Создать для кнопки контекстное меню с пунктами Код 1, Код 2, Код 3 и связать пункты меню с процедурами Primer1, Primer2, Primer3.
Привязать контекстное меню к созданной кнопке с реагированием на правый клик мышью.

Добавление кнопки ActiveX на лист

Кнопку можно добавить вручную, но мы создадим её с помощью VBA Excel.

Sub AddActiveXButton()
    Dim btn As OLEObject
    
    Set btn = ActiveSheet.OLEObjects.Add( _
        ClassType:="Forms.CommandButton.1", _
        link:=False, _
        DisplayAsIcon:=False, _
        Left:=100, Top:=100, Width:=120, Height:=30)
    
    btn.name = "MyButton"
    btn.Object.Caption = "Нажми меня"
End Sub

Sub AddActiveXButton()

Dim btn As OLEObject

Set btn = ActiveSheet.OLEObjects.Add( _

ClassType:="Forms.CommandButton.1", _

link:=False, _

DisplayAsIcon:=False, _

Left:=100, Top:=100, Width:=120, Height:=30)

btn.name = "MyButton"

btn.Object.Caption = "Нажми меня"

End Sub

Пояснения:

OLEObjects.Add — добавляет элемент ActiveX.
ClassType — тип элемента (указываем кодовое выражение для кнопки).
Left, Top, Width, Height — позиция и размер элемента.
Caption — текст на кнопке.
Кнопка добавляется на активный лист — ActiveSheet (вы можете указать лист явно).

Код размещается в стандартном модуле.

Создание контекстного меню

Теперь создадим собственное контекстное меню с тремя пунктами: Код 1, Код 2, Код 3, и привязкой к этим пунктам процедур Primer1, Primer2, Primer3.

Sub CreateContextMenu()
    Dim cb As CommandBar
    Dim ctrl As CommandBarControl
    
    ' Удаляем меню, если уже существует
    On Error Resume Next
    Application.CommandBars("MyContextMenu").Delete
    On Error GoTo 0
    
    ' Создаём новое меню
    Set cb = Application.CommandBars.Add( _
        name:="MyContextMenu", _
        position:=msoBarPopup, _
        Temporary:=False)
    
    ' Добавляем пункт "Код 1"
    Set ctrl = cb.Controls.Add(Type:=msoControlButton)
    ctrl.Caption = "Код 1"
    ctrl.OnAction = "Primer1"
    
    ' Добавляем пункт "Код 2"
    Set ctrl = cb.Controls.Add(Type:=msoControlButton)
    ctrl.Caption = "Код 2"
    ctrl.OnAction = "Primer2"
    
    ' Добавляем пункт "Код 3"
    Set ctrl = cb.Controls.Add(Type:=msoControlButton)
    ctrl.Caption = "Код 3"
    ctrl.OnAction = "Primer3"
End Sub

Sub CreateContextMenu()

Dim cb As CommandBar

Dim ctrl As CommandBarControl

' Удаляем меню, если уже существует

On Error Resume Next

Application.CommandBars("MyContextMenu").Delete

On Error GoTo 0

' Создаём новое меню

Set cb = Application.CommandBars.Add( _

name:="MyContextMenu", _

position:=msoBarPopup, _

Temporary:=False)

' Добавляем пункт "Код 1"

Set ctrl = cb.Controls.Add(Type:=msoControlButton)

ctrl.Caption = "Код 1"

ctrl.OnAction = "Primer1"

' Добавляем пункт "Код 2"

Set ctrl = cb.Controls.Add(Type:=msoControlButton)

ctrl.Caption = "Код 2"

ctrl.OnAction = "Primer2"

' Добавляем пункт "Код 3"

Set ctrl = cb.Controls.Add(Type:=msoControlButton)

ctrl.Caption = "Код 3"

ctrl.OnAction = "Primer3"

End Sub

Код размещается в стандартном модуле.

Привязка контекстного меню к кнопке

Чтобы при правом клике по кнопке ActiveX открывалось наше контекстное меню, нужно обработать событие кнопки MouseDown.

Самый простой вариант

Private Sub MyButton_MouseDown(ByVal Button As Integer, _
                              ByVal Shift As Integer, _
                              ByVal X As Single, _
                              ByVal Y As Single)

    ' Правая кнопка мыши
    If Button = 2 Then
        Application.CommandBars("MyContextMenu").ShowPopup
    End If

End Sub

Private Sub MyButton_MouseDown(ByVal Button As Integer, _

ByVal Shift As Integer, _

ByVal X As Single, _

ByVal Y As Single)

' Правая кнопка мыши

If Button = 2 Then

Application.CommandBars("MyContextMenu").ShowPopup

End If

End Sub

Код размещается в модуле листа, на котором будет создана кнопка.

Защита от отсутствия меню

Если по какой-то причине меню ещё не создано (или было удалено), указанный выше код вызовет ошибку. Лучше добавить проверку на отсутствие контекстного меню:

Private Sub MyButton_MouseDown(ByVal Button As Integer, _
                              ByVal Shift As Integer, _
                              ByVal X As Single, _
                              ByVal Y As Single)

    If Button = 2 Then
        On Error Resume Next
        Application.CommandBars("MyContextMenu").ShowPopup
        If Err.number <> 0 Then
            MsgBox "Контекстное меню не найдено. Выполните инициализацию.", vbExclamation
            Err.Clear
        End If
        On Error GoTo 0
    End If

End Sub

Private Sub MyButton_MouseDown(ByVal Button As Integer, _

ByVal Shift As Integer, _

ByVal X As Single, _

ByVal Y As Single)

If Button = 2 Then

On Error Resume Next

Application.CommandBars("MyContextMenu").ShowPopup

If Err.number <> 0 Then

MsgBox "Контекстное меню не найдено. Выполните инициализацию.", vbExclamation

Err.Clear

End If

On Error GoTo 0

End If

End Sub

Код размещается в модуле листа, на котором будет создана кнопка.

Процедуры, вызываемые из меню

Добавим процедуры, которые будут выполняться при выборе пунктов меню:

Sub Primer1()
    MsgBox "Запущен Код 1"
End Sub
 
Sub Primer2()
    MsgBox "Запущен Код 2"
End Sub
 
Sub Primer3()
    MsgBox "Запущен Код 3"
End Sub

Sub Primer1()

MsgBox "Запущен Код 1"

End Sub

Sub Primer2()

MsgBox "Запущен Код 2"

End Sub

Sub Primer3()

MsgBox "Запущен Код 3"

End Sub

Код размещается в стандартном модуле.

Инициализация

Чтобы всё работало корректно, выполните инициализацию:

Sub Init()
    Call AddActiveXButton
    Call CreateContextMenu
End Sub

Sub Init()

Call AddActiveXButton

Call CreateContextMenu

End Sub

Код размещается в стандартном модуле. Обе процедуры можно запустить и по отдельности из редактора VBA.

Результат работы кода

Отображение контекстного меню для кнопки ActiveX:

Контекстное меню для кнопки ActiveX

Результат нажатия пункта «Код 1»:

Сообщение о запуске кода из контекстного меню

Примечания

Контекстное меню создаётся постоянное. Если нужно временное меню, которое исчезает при закрытии Excel, замените Temporary:=False на Temporary:=True.
Вы можете добавить макрос для клика левой кнопкой мышы.
Элементы ActiveX работают только при включённых макросах в параметрах Excel.

Добавление контекстного меню к элементам управления ActiveX с помощью VBA позволяет существенно расширить стандартный интерфейс программы Excel.

Содержание рубрики VBA Excel по тематическим разделам со ссылками на все статьи.