Читаем Excel. Трюки и эффекты полностью

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