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
