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()
' Перемещение влево