Cells(intRow, 3) = cbrcSubSubMenu.Caption
' Переходим на следующую строку
intRow = intRow + 1
Next cbrcSubSubMenu
Next cbrcSubMenu
Next cbrcMenu
End Sub
После запуска макроса ListOfMenues (этот макрос появится в окне выбора макросов после написания приведенного выше кода) список подменю и команд главного меню будет сформирован на текущем рабочем листе.
Создание списка пунктов контекстных меню
Чтобы вывести аналогичный список содержимого контекстных меню программы, нужно написать и выполнить макрос, код которого приведен в листинге 3.88.
Sub ListOfContextMenues()
Dim intRow As Long
Dim intControl As Integer
Dim cbrBar As CommandBar
' Очистка ячеек активного листа
Cells.Clear
' Начинаем вывод с первой строки
intRow = 1
' Просмотр списка контекстных меню и вывод информации о них
For Each cbrBar In CommandBars
If cbrBar.Type = msoBarTypePopup Then
' Порядковый номер
Cells(intRow, 1) = cbrBar.Index
' Название
Cells(intRow, 2) = cbrBar.Name
' Просмотр всех элементов контекстного меню и вывод _
названий этих элементов в ячейки текущей строки
For intControl = 1 To cbrBar.Controls.Count
Cells(intRow, intControl + 2) = _
cbrBar.Controls(intControl).Caption
Next intControl
' Переход на следующую строку таблицы
intRow = intRow + 1
End If
Next cbrBar
' Делаем ширину ячеек таблицы оптимальной для просмотра
Cells.EntireColumn.AutoFit
End Sub
Сформированный в результате выполнения данного макроса список будет расположен на текущем рабочем листе.
Отображение панели инструментов при определенном условии
Можно сделать так, что созданная пользователем панель инструментов будет отображаться на экране (а именно – на вкладке Надстройки) только при выполнении какого-либо условия. В данном разделе мы рассмотрим прием, после реализации которого созданная пользователем панель инструментов будет отображаться лишь тогда, когда курсор находится в определенном диапазоне.
В модуле рабочего листа напишем следующий код (листинг 3.89).
Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
' Проверка условия отображения
If Union(Target, Range(«A1:D5»)).Address = _
Range(«A1:D5»).Address Then
' Условие выполнено – можно показывать панель
CommandBars(«AutoSense»).Visible = True
Else
' Условие не выполнено – панель нужно скрыть
CommandBars(«AutoSense»).Visible = False
End If
End Sub
Из содержимого данного кода видно, что условием отображения пользовательской панели инструментов на вкладке Надстройки будет выделение любой ячейки диапазона A1:D5 (либо выделение произвольного диапазона внутри данного диапазона).
Теперь необходимо написать в стандартном модуле код, содержимое которого приведено в листинге 3.90. Для начала работы с панелью необходимо запустить макрос CreatePanel.
Sub CreatePanel()
Dim cbrBar As CommandBar
Dim button As CommandBarButton
Dim i As Integer
' Удаление одноименной панели (при ее наличии)
On Error Resume Next
CommandBars(«AutoSense»).Delete
On Error GoTo 0
' Создание панели инструментов
Set cbrBar = CommandBars.Add
' Создание кнопок и их настройка
For i = 1 To 4
Set button = cbrBar.Controls.Add(msoControlButton)
With button
.OnAction = «ButtonClick» & i
.FaceId = i + 37
End With
Next i
cbrBar.Name = «AutoSense»
End Sub
Sub ButtonClick3()
' Перемещение вниз
On Error Resume Next
ActiveCell.Offset(1, 0).Activate
End Sub
Sub ButtonClick1()
' Перемещение вверх
On Error Resume Next
ActiveCell.Offset(-1, 0).Activate
End Sub
Sub ButtonClick2()
' Перемещение вправо
On Error Resume Next
ActiveCell.Offset(0, 1).Activate
End Sub
Sub ButtonClick4()
' Перемещение влево
On Error Resume Next
ActiveCell.Offset(0, -1).Activate
End Sub
Созданная панель инструментов называется AutoSense и включает в себя четыре кнопки со стрелками, предназначенные для перемещения курсора на одну ячейку в соответствующем направлении. Эта панель будет отображаться на вкладке Надстройки только при условии, что курсор расположен внутри диапазона A1:D5. Если курсор вывести из этого диапазона даже с помощью кнопок данной панели, то она перестанет отображаться и появится вновь только при соблюдении указанного условия.
Скрытие и отображение панелей инструментов
В данном разделе мы научимся быстро управлять отображением всех используемых в Excel 2007 панелей инструментов.
Внимание!
Для успешной реализации данного примера в текущей рабочей книге должен находиться лист Лист1. В противном случае необходимо внести соответствующие изменения в приведенный ниже код.
В стандартном модуле редактора VBA напишем следующий код (листинг 3.91).
Sub HidePanels()
Dim cbrBar As CommandBar
Dim intRow As Integer ' Номер текущей строки листа
' Отключение обновления экрана
Application.ScreenUpdating = False
' Подготовка к сохранению
Cells.Clear
' Скрытие видимых панелей и сохранение их названий
intRow = 1 ' Запись имен с первой строки
For Each cbrBar In CommandBars
If cbrBar.Type = msoBarTypeNormal Then
If cbrBar.Visible Then
cbrBar.Visible = False
Cells(intRow, 1) = cbrBar.Name
intRow = intRow + 1
End If
End If
Next
' Включение обновления экрана
Application.ScreenUpdating = True
End Sub
Sub ShowPanels()
Dim cell As Range ' Текущая ячейка листа
' Отключение обновления экрана
Application.ScreenUpdating = False
' Отображение скрытых панелей
On Error Resume Next
For Each cell In Range(«A:A»).SpecialCells( _
xlCellTypeConstants)
CommandBars(cell.Value).Visible = True
Next cell
' Включение обновления экрана
Application.ScreenUpdating = True
End Sub
После написания кода в окне выбора макросов появятся два макроса: Hide Panel s и ShowPanels. При выполнении первого макроса все используемые панели инструментов будут скрыты, а при выполнении второго они восстановятся на прежних местах. На рабочем листе Лист1 будет храниться перечень скрытых панелей. Для удобства работы можно назначить обоим макросам кнопки и поместить их на рабочий лист (но не на какую-нибудь панель инструментов).
Создание меню на основе данных рабочего листа
Рассмотрим еще один способ создания пользовательского меню, которое будет отображаться на вкладке Надстройки. Характерной особенностью данного способа является то, что основой для формирования меню будут хранящиеся на рабочем листе данные.
В качестве исходных данных для создания пользовательского меню используем содержимое листа ЛистМеню (рис. 3.34).
Рис. 3.34. Исходные данные
Теперь в модуле ЭтаКнига напишем такой код (листинг 3.92).
Sub Workbook_Open()
' Создание меню
Call CreateCustomMenu
End Sub
Sub Workbook_BeforeClose(Cancel As Boolean)
' Удаление меню перед закрытием книги
Call DeleteCustomMenu
End Sub
Следующий код (листинг 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
' Следующий элемент вложен в создаваемый, то есть _