Меню с пользовательскими командами

Листинг 3.82. Код в модуле ЭтаКнига

Sub Workbook_Open()

' Задание имени меню

strMenuName = " MyCommandBarName"

' Создание меню

CreateCustomMenu

End Sub

Sub Workbook_BeforeClose(Cancel As Boolean)

' Удаление меню перед закрытием книги

DeleteCustomMenu

End Sub

Листинг 3.83. Код в стандартном модуле

Public strMenuName As String ' Имя строки меню

Private cbrcBar As CommandBarControl

Sub CreateCustomMenu()

Dim cbrMenu As CommandBar

Dim cbrcMenu As CommandBarControl ' Выпадающее меню " Меню"

Dim cbrcSubMenu As CommandBarControl ' Выпадающее меню " Дополнительно"

' Если уже есть пользовательское меню, то оно удаляется

DeleteCustomMenu

' Создание меню вместо стандартного

Set cbrMenu = Application.CommandBars.Add(strMenuName, msoBarTop, _

True, True)

' Создание выпадающего меню с названием " Меню"

Set cbrcMenu = cbrMenu.Controls.Add(msoControlPopup,,,, True)

With cbrcMenu

.Caption = " & Меню"

End With

' Создание пункта меню

With cbrcMenu.Controls.Add(Type: =msoControlButton, _

Temporary: =True)

.Caption = " & Меню1"

.OnAction = " CallMenu1"

End With

' Создание пункта меню

With cbrcMenu.Controls.Add(Type: =msoControlButton, _

Temporary: =True)

.Caption = " Меню2"

.OnAction = " CallMenu2"

End With

' Создание подменю первого уровня

Set cbrcSubMenu = cbrcMenu.Controls.Add(Type: =msoControlPopup, _

Temporary: =True)

With cbrcSubMenu

.Caption = " Подменю1"

.BeginGroup = True

End With

' Создание пункта меню

With cbrcMenu.Controls.Add(Type: =msoControlButton, _

Temporary: =True)

.Caption = " Вкл/Выкл"

.OnAction = " MenuOnOff"

.Style = msoButtonIconAndCaption

.FaceId = 463

End With

' Создание пункта меню в подменю первого уровня

With cbrcSubMenu.Controls.Add(Type: =msoControlButton, _

Temporary: =True)

.Caption = " Подменю1"

.OnAction = " CallSubMenu1"

.Style = msoButtonIconAndCaption

.FaceId = 2950

.State = msoButtonDown

End With

' Cоздание пункта меню в подменю первого уровня (его состояние _

изменяется посредством пункта " Вкл/Выкл"), для чего сохраним ссылку _

на созданный пункт меню

Set cbrcBar = cbrcSubMenu.Controls.Add(Type: =msoControlButton, _

Temporary: =True)

With cbrcBar

.Caption = " Подменю2"

.OnAction = " CallSubMenu2"

' Сначала меню деактивировано

.Enabled = False

End With

' Создание подменю второго уровня

Set cbrcSubMenu = cbrcSubMenu.Controls.Add(Type: =msoControlPopup, _

Temporary: =True)

With cbrcSubMenu

.Caption = " ПодчПодменю1"

.BeginGroup = True

End With

' Cоздание пункта меню в подменю второго уровня

With cbrcSubMenu.Controls.Add(Type: =msoControlButton, _

Temporary: =True)

.Caption = " ПослМеню1"

.OnAction = " CallLastMenu1"

.Style = msoButtonIconAndCaption

.FaceId = 71

.State = msoButtonDown

End With

' Cоздание пункта меню в подменю второго уровня

With cbrcSubMenu.Controls.Add(Type: =msoControlButton, _

Temporary: =True)

.Caption = " ПослМеню2"

.OnAction = " CallLastMenu2"

.Style = msoButtonIconAndCaption

.FaceId = 72

.Enabled = True

End With

' Отображение меню

cbrMenu.Visible = True

Set cbrcSubMenu = Nothing

Set cbrcMenu = Nothing

Set cbrMenu = Nothing

End Sub

Sub DeleteCustomMenu()

' Удаление строки меню

On Error Resume Next

Application.CommandBars(strMenuName).Delete

On Error GoTo 0

End Sub

Sub CallMenu1()

' Обработка вызова Меню1

MsgBox " Приветствует меню 1! ", vbInformation, ThisWorkbook.Name

End Sub

Sub CallMenu2()

' Обработка вызова Меню2

MsgBox " Приветствует меню 2! ", vbInformation, ThisWorkbook.Name

End Sub

Sub CallSubMenu1()

' Обработка вызова Подменю1

MsgBox " Приветствует подменю 1! ", vbInformation, ThisWorkbook.Name

End Sub

Sub CallSubMenu2()

' Обработка вызова Подменю2

MsgBox " Приветствует подменю 2! ", vbInformation, ThisWorkbook.Name

End Sub

Sub CallLastMenu1()

' Обработка вызова Последнего меню1

MsgBox " Приветствует последнее меню 1! ", vbInformation, ThisWorkbook.Name

End Sub

Sub CallLastMenu2()

' Обработка вызова Последнего меню2

MsgBox " Приветствует последнее меню 2! ", vbInformation, ThisWorkbook.Name

End Sub

Sub MenuOnOff()

' Активация или деактивация пункта " Меню-Подменю1-Подменю2"

cbrcBar.Enabled = Not cbrcBar.Enabled

End Sub