Меню с пользовательскими командами
Для реализации данного трюка нам потребуется создать два кода. Один из них будет помещен в модуль ЭтаКнига, а другой – в стандартный модуль. Первый код выглядит следующим образом (листинг 3.79).
Листинг 3.79. Код в модуле ЭтаКнига
Sub Workbook_Open()
' Задание имени меню
strMenuName = «MyCommandBarName»
' Создание меню
CreateCustomMenu
End Sub
Sub Workbook_BeforeClose(Cancel As Boolean)
' Удаление меню перед закрытием книги
DeleteCustomMenu
End Sub
Второй код необходимо набрать в любом стандартном модуле. В нем определяется структура пользовательского меню и порядок его работы. Содержимое данного кода представлено в листинге 3.80.
Листинг 3.80. Код в стандартном модуле
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()
' Обработка вызова Подменю1
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
Чтобы пользовательское меню отобразилось на вкладке Надстройки, необходимо запустить макрос CreateCustomMenu (после написания кода данный макрос будет доступен в окне выбора макросов). Результат представлен на рис. 3.29.
Рис. 3.29. Созданное пользовательское меню
Данное меню работает следующим образом: при выполнении любой его команды появляется окно с соответствующим сообщением (рис. 3.30). Исключение составляет команда Вкл/Выкл – с ее помощью осуществляется включение/выключение пункта Подменю1 ? Подменю2.
Рис. 3.30. Результат выбора пункта Меню1
Чтобы вернуться в первоначальное состояние, необходимо воспользоваться макросом DeleteCustomMenu (в некоторых случаях для «отката» нужно закрыть рабочую книгу, затем вновь открыть ее и лишь после этого запустить макрос DeleteCustomMenu). Однако проще сделать по-другому: нужно щелкнуть правой кнопкой мыши на созданном меню и в открывшемся контекстном меню выполнить команду Удалить настраиваемую панель инструментов, после чего подтвердить удаление.