Создание пользовательского меню (вариант 6)

Sub CreateMenu()

Dim cbrMenu As CommandBar

Dim cbrcNewMenu As CommandBarControl

' Удаление меню, если оно уже есть

Call DeleteMenu

' Добавление строки пользовательского меню

Set cbrMenu = CommandBars.Add(MenuBar:=True)

With cbrMenu

.Name = "Моя строка меню"

.Visible = True

End With

' Копирование стандартного меню "Файл"

CommandBars("Worksheet Menu Bar").FindControl(ID:=30002).Copy _

CommandBars("Моя строка меню")

' Добавление нового меню - "Дополнительно"

Set cbrcNewMenu = cbrMenu.Controls.Add(msoControlPopup)

cbrcNewMenu.Caption = "&Дополнительно"

' Добавление команды в новое меню

With cbrcNewMenu.Controls.Add(msoControlButton)

.Caption = "&Восстановить обычную строку меню"

.OnAction = "DeleteMenu"

End With

' Добавление команды в новое меню

With cbrcNewMenu.Controls.Add(Type:=msoControlButton)

.Caption = "&Справка"

End With

End Sub

Sub DeleteMenu()

' Пытаемся удалить меню (успешно, если оно ранее создано)

On Error Resume Next

CommandBars("Моя строка меню").Delete

On Error GoTo 0

End Sub

Список панелей инструментов и контекстных меню

Sub ListOfMenues()

Dim intRow As Integer ' Хранит текущую строку

Dim cbrBar As CommandBar

' Очистка всех ячеек текущего листа

Cells.Clear

intRow = 1 ' Начинаем запись с первой строки

' Просматриваем список панелей инструментов и меню _

и записываем информацию о каждом элементе в таблицу

For Each cbrBar In CommandBars

' Порядковый номер

Cells(intRow, 1) = cbrBar.Index

' Название

Cells(intRow, 2) = cbrBar.Name

' Тип

Select Case cbrBar.Type

Case msoBarTypeNormal

Cells(intRow, 3) = "Панель инструментов"

Case msoBarTypeMenuBar

Cells(intRow, 3) = "Строка меню"

Case msoBarTypePopup

Cells(intRow, 3) = "Контекстное меню"

End Select

' Встроенный элемент или созданный пользователем

Cells(intRow, 4) = cbrBar.BuiltIn

' Переходим на следующую строку

intRow = intRow + 1

Next

End Sub

Создание списка пунктов главного меню Excel

Листинг 3.90. Список содержимого главного меню

Sub ListOfMenues()

Dim intRow As Integer ' Текущая строка, куда идет запись

Dim cbrcMenu As CommandBarControl ' Главное меню

Dim cbrcSubMenu As CommandBarControl ' Подменю

Dim cbrcSubSubMenu As CommandBarControl ' Подменю в подменю

' Очищаем ячейки текущего листа

Cells.Clear

' Начинаем запись с первой строки

intRow = 1

' Просматриваем все элементы строки меню

On Error Resume Next ' Игнорируем ошибки

For Each cbrcMenu In CommandBars(1).Controls

' Просматриваем элементы выпадающего меню cbrcMenu

For Each cbrcSubMenu In cbrcMenu.Controls

' Просматриваем элементы подменю cbrcSubMenu

For Each cbrcSubSubMenu In cbrcSubMenu.Controls

' Выводим название главного меню

Cells(intRow, 1) = cbrcMenu.Caption

' Выводим название подменю

Cells(intRow, 2) = cbrcSubMenu.Caption

' Выводим название вложенного подменю

Cells(intRow, 3) = cbrcSubSubMenu.Caption

' Переходим на следующую строку

intRow = intRow + 1

Next cbrcSubSubMenu

Next cbrcSubMenu

Next cbrcMenu

End Sub