Создание меню на основе данных рабочего листа

Рассмотрим еще один способ создания пользовательского меню, которое будет отображаться на вкладке Надстройки. Характерной особенностью данного способа является то, что основой для формирования меню будут хранящиеся на рабочем листе данные.

В качестве исходных данных для создания пользовательского меню используем содержимое листа ЛистМеню (рис. 3.34).

Рис. 3.34. Исходные данные

Теперь в модуле ЭтаКнига напишем такой код (листинг 3.92).

Листинг 3.92. Код в модуле ЭтаКнига

Sub Workbook_Open()

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

Call CreateCustomMenu

End Sub

Sub Workbook_BeforeClose(Cancel As Boolean)

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

Call DeleteCustomMenu

End Sub

Следующий код (листинг 3.93) необходимо написать в стандартном модуле.

Листинг 3.93. Код в стандартном модуле

Sub CreateMenu()

Dim sheet As Worksheet ' Лист с описанием меню

Dim intRow As Integer ' Считываемая строка

Dim cbrpBar As CommandBarPopup ' Выпадающее меню

Dim objNewItem As Object ' Элемент меню cbrpBar

Dim objNewSubItem As Object ' Элемент подменю objNewItem

Dim intMenuLevel As Integer ' Уровень вложенности пункта меню

Dim strCaption As String ' Название пункта меню

Dim strAction As String ' Макрос пункта меню

Dim fIsDevider As Boolean ' Нужен разделитель

Dim intNextLevel As Integer ' Уровень вложенности следующего _

пункта меню

Dim strFaceID As String ' Номер значка пункта меню

' Расположение данных для меню

Set sheet = ThisWorkbook.Sheets(«ЛистМеню»)

' Удаление одноименного меню (при его наличии)

Call DeleteMenu

' Данные считываем со второй строки

intRow = 2

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

Do Until IsEmpty(sheet.Cells(intRow, 1))

' Считываем информацию о пункте меню

With sheet

' Уровень вложенности

intMenuLevel = .Cells(intRow, 1)

' Название

strCaption = .Cells(intRow, 2)

' Название макроса для меню

strAction = .Cells(intRow, 3)

' Нужен ли разделитель перед меню?

fIsDevider = .Cells(intRow, 4)

' Номер стандартного значка (если значок нужен)

strFaceID = .Cells(intRow, 5)

' Уровень вложенности следующего меню

intNextLevel = .Cells(intRow + 1, 1)

End With

' Создаем меню в зависимости от уровня его вложенности

Select Case intMenuLevel

Case 1

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

Set cbrpBar = Application.CommandBars(1). _

Controls.Add(Type:=msoControlPopup, _

Before:=strAction, _

Temporary:=True)

cbrpBar.Caption = strCaption

Case 2

' Создаем элемент меню

If intNextLevel = 3 Then

' Следующий элемент вложен в создаваемый, то есть _

создаем раскрывающееся подменю

Set objNewItem = _

cbrpBar.Controls.Add(Type:=msoControlPopup)

Else

' Создаем команду меню

Set objNewItem = _

cbrpBar.Controls.Add(Type:=msoControlButton)

objNewItem.OnAction = strAction

End If

' Установка названия нового пункта меню

objNewItem.Caption = strCaption

' Установка значка нового пункта меню (если нужно)

If strFaceID <> "" Then

objNewItem.FaceId = strFaceID

End If

' Если нужно, то добавим разделитель

If fIsDevider Then

objNewItem.BeginGroup = True

End If

Case 3

' Создание элемента подменю

Set objNewSubItem = _

objNewItem.Controls.Add(Type:=msoControlButton)

' Установка его названия

objNewSubItem.Caption = strCaption

' Назначение макроса (или команды)

objNewSubItem.OnAction = strAction

' Установка значка (если нужно)

If strFaceID <> "" Then

objNewSubItem.FaceId = strFaceID

End If

' Если нужно, то добавим разделитель

If fIsDevider Then

objNewSubItem.BeginGroup = True

End If

End Select

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

intRow = intRow + 1

Loop

End Sub

Sub DeleteMenu()

Dim sheet As Worksheet ' Лист с описанием меню

Dim intRow As Integer ' Считываемая строка

Dim strCaption As String ' Название меню

Set sheet = ThisWorkbook.Sheets(«ЛистМеню»)

' Данные начинаются со второй строки

intRow = 2

' Считываем данные, пока есть значения в столбце "A", _

и удаляем созданные ранее меню (с уровнем вложенности 1)

On Error Resume Next

Do Until IsEmpty(sheet.Cells(intRow, 1))

If sheet.Cells(intRow, 1) = 1 Then

strCaption = sheet.Cells(intRow, 2)

Application.CommandBars(1).Controls(strCaption).Delete

End If

intRow = intRow + 1

Loop

On Error GoTo 0

End Sub

После того как данный код написан, в окне выбора макросов появятся макросы CreateMenu и DeleteMflenu – соответственно для создания и удаления пользовательского меню. Для удобства работы можно назначить каждому макросу кнопки.

Пользовательское меню, созданное на основании приведенных на рис. 3.34 исходных данных, показано на рис. 3.35.

Рис. 3.35. Пользовательское меню Выручка

Новое меню будет автоматически формироваться при каждом открытии рабочей книги и удаляться при ее закрытии.