Отображение панели инструментов при определенном условии

Создание списка пунктов контекстных меню

Создание списка пунктов главного меню 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

Листинг 3.91. Список содержимого контекстных меню

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.92. Код в модуле рабочего листа

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

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

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

Дата добавления: 2015-06-25