Алексей Гладкий - Excel. Трюки и эффекты

Сначала рассмотрим создание пользовательского меню, которое полностью состоит из пользовательских команд. После этого реализуем меню, в котором наряду с пользовательскими будут и штатные средства Excel.

Для реализации данного трюка нам потребуется создать два кода. Один из них будет помещен в модуль ЭтаКнига, а другой – в стандартный модуль. Первый код выглядит следующим образом (листинг 3.79).

Sub Workbook_Open()

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

strMenuName = «MyCommandBarName»

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

CreateCustomMenu

End Sub

Sub Workbook_BeforeClose(Cancel As Boolean)

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

DeleteCustomMenu

End Sub

Второй код необходимо набрать в любом стандартном модуле. В нем определяется структура пользовательского меню и порядок его работы. Содержимое данного кода представлено в листинге 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.