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
