Dim cbrBar As CommandBar
Dim i As Integer
' Получение доступа к списку шрифтов (элемент управления в виде _
раскрывающегося списка на панели инструментов «Форматирование»)
Set cbrcFonts = Application.CommandBars(«Formatting»). _
FindControl(ID:=1728)
If cbrcFonts Is Nothing Then
' Панель «Форматирование» не открыта – откроем ее
Set cbrBar = Application.CommandBars.Add
Set cbrcFonts = cbrBar.Controls.Add(ID:=1728)
End If
' Подготовка к выводу шрифтов (очистка ячеек)
Range(«A:A»).ClearContents
' Вывод списка шрифтов в столбец "A" текущего листа
For i = 0 To cbrcFonts.ListCount – 1
Cells(i + 1, 1) = cbrcFonts.List(i + 1)
Next i
' Закрытие панели инструментов «Форматирование», если мы были _
вынуждены ее открывать
On Error Resume Next
cbrBar.Delete
End Sub
В результате работы данного макроса перечень доступных шрифтов будет сформирован на активном рабочем листе в столбце А. После этого список шрифтов можно по обычным правилам вывести на печать.
Создание раскрывающегося списка
Раскрывающийся список является одним из наиболее удобных элементов управления, поскольку с его помощью можно быстро установить требуемое значение того или иного элемента интерфейса (в частности, ячейки). В этом разделе мы рассмотрим пример, реализация которого поможет пользователю самостоятельно создавать раскрывающиеся списки с заранее заданным перечнем возможных значений.
Предположим, что нам необходимо создать раскрывающийся список, имеющий 12 возможных значений, каждое из которых представляет собой название месяца. Для удобства использования поместим этот список на панель инструментов, которую также создадим самостоятельно.
Для решения поставленной задачи напишем в стандартном модуле редактора VBA код, который представлен в листинге 3.102.
Sub CreatePanel()
Dim i As Integer
On Error Resume Next
' Удаление одноименной панели (если есть)
CommandBars(«Список месяцев»).Delete
On Error GoTo 0
' Создание панели «Список месяцев»
With CommandBars.Add
.Name = «Список месяцев»
' Создание списка месяцев
With .Controls.Add(Type:=msoControlDropdown)
' Настройка (имя, макрос, стиль)
.Caption = «DateDD»
.OnAction = «SetMonth»
.Style = msoButtonAutomatic
' Добавление в список названий месяцев
For i = 1 To 12
.AddItem Format(DateSerial(1, i, 1), «mmmm»)
Next i
' Выделение первого месяца
.ListIndex = 1
End With
' Показываем созданную панель
.Visible = True
End With
End Sub
Sub SetMonth()
' Перенос названия выделенного месяца в ячейку
On Error Resume Next
With CommandBars(«Список месяцев»).Controls(«DateDD»)
ActiveCell.Value = .List(.ListIndex)
End With
End Sub
В результате написания данного кода будут созданы два макроса: CreatePanel и SetMonth. Первый предназначен для создания панели инструментов с раскрывающимся списком (рис. 3.40), а второй – для помещения выбранной позиции списка в активную ячейку рабочего листа.
Рис. 3.40. Созданный раскрывающийся список
Подобным образом можно создавать любые раскрывающиеся списки с произвольным перечнем значений, как включенные в панель инструментов, так и созданные отдельно от нее, – для этого достаточно внести соответствующие изменения в приведенный выше код.
Добавление команды на вкладку
Выше мы рассматривали несколько способов формирования пользовательских меню и включали их во вкладку либо в контекстное меню. Однако в процессе эксплуатации программы могут возникать ситуации, когда для решения той или иной задачи можно обойтись лишь одной пользовательской командой, поместив ее на вкладку Надстройки. В данном разделе мы рассмотрим, каким образом можно добавить пользовательскую команду на эту вкладку.
Добавление команды «Очистить все, кроме формул»
Итак, добавим на вкладку Надстройки пользовательскую команду Очистить все, кроме формул. Кроме того, для удобства работы назначим данной команде сочетание клавиш Ctrl+Shift+C.
Для реализации поставленной задачи необходимо в стандартном модуле редактора VBA написать код, который выглядит следующим образом (листинг 3.103).
Sub AddMenuItem()
Dim cbrpMenu As CommandBarPopup
' Удаление аналогичной команды (при ее наличии)
Call DeleteMenuItem
' Получение доступа к меню «Сервис»
Set cbrpMenu = CommandBars(1).FindControl(ID:=30007)
If cbrpMenu Is Nothing Then
' Не удалось получить доступ
MsgBox «Невозможно добавить элемент.»
Exit Sub
Else
' Добавление новой команды в меню
With cbrpMenu.Controls.Add(Type:=msoControlButton)
' Название команды
.Caption = «Очистить в&се, кроме формул»
' Значок
.FaceId = 348
' Сочетание клавиш (только надпись на кнопке)
.ShortcutText = «Ctrl+Shift+C»
' Сопоставленный макрос
.OnAction = «ExecuteCommand»
' Добавление разделителя перед командой
.BeginGroup = True
End With
End If
' Сопоставление с макросом сочетания клавиш Ctrl+Shift+C
Application.MacroOptions _
Macro:="ExecuteCommand", _
HasShortcutKey:=True, _
ShortcutKey:="C"
End Sub
Sub ExecuteCommand()
' Очистка содержимого всех ячеек (кроме формул)
On Error Resume Next
Cells.SpecialCells(xlCellTypeConstants, 23).ClearContents
End Sub
Sub DeleteMenuItem()
' Удаление команды из меню
On Error Resume Next
CommandBars(1).FindControl(ID:=30007). _
Controls(«Очистить в&се, кроме формул»).Delete
End Sub
В результате написания кода будут созданы три макроса: AddMenuItem (добавление команды Очистить все, кроме формул на вкладку Надстройки), DeleteMenultem (удаление созданной команды) и ExecuteCommand (макрос запускается при выполнении команды).
Новая команда на вкладке Надстройки показана на рис. 3.41.
При выполнении данной команды из ячеек текущего рабочего листа будет удалена вся информация, за исключением формул. Следует отметить, что данную операцию можно выполнять и без помощи команды Очистить все, кроме формул – для этого достаточно запустить макрос ExecuteCommand.
Рис. 3.41. Новая команда на вкладке Надстройки
Чтобы удалить команды Очистить все, кроме формул, нужно выполнить макрос DeleteMenuItem. Можно также щелкнуть на ней правой кнопкой мыши и в открывшемся контекстном меню выбрать команду Удалить настраиваемую команду.
Добавление команды «Линии сетки»
Добавим на вкладку Надстройки пользовательскую команду Линии сетки. С помощью данной команды можно будет управлять отображением сетки на текущем рабочем листе.
Итак, в стандартном модуле редактора VBA напишем код, который представлен в листинге 3.104.
Dim AppObject As New Class1
Sub AddCommand()
Dim cbrpBar As CommandBarPopup
' Удаление аналогичной команды (при ее наличии)
Call DeleteCommand
' Получение доступа к меню «Вид»
Set cbrpBar = CommandBars(1).FindControl(ID:=30004)
If cbrpBar Is Nothing Then
' Не удалось получить доступ к меню
MsgBox «Невозможно добавить элемент меню.»
Exit Sub
Else
' Добавление команды
With cbrpBar.Controls.Add(Type:=msoControlButton)
.Caption = «&Линии сетки»
.OnAction = «GhangeGridlinesState»
End With
End If
' Даем объекту AppObject обрабатывать события
Set AppObject.AppEvents = Application
End Sub
Sub DeleteCommand()
' Удаление каманды из меню (если она там есть)
On Error Resume Next
CommandBars(1).FindControl(ID:=30004). _
Controls(«&Линии сетки»).Delete
End Sub
Sub GhangeGridlinesState()
' Изменение состояния отображения линий сетки _
на противоположное (если нет – покажем, если есть – скроем)
If TypeName(ActiveSheet) = «Worksheet» Then
ActiveWindow.DisplayGridlines = _
Not ActiveWindow.DisplayGridlines
' Установка или снятие флажка в меню
Call CheckGridlines
End If
End Sub
Sub CheckGridlines()
Dim button As CommandBarButton
On Error Resume Next
' Поиск команды «Линии сетки» в меню «Вид»
Set button = CommandBars(1).FindControl(ID:=30004). _
Controls(«&Линии сетки»)
' Изменение состояния флажка на противоположное
If ActiveWindow.DisplayGridlines Then
' Установка
button.State = msoButtonDown
Else
' Снятие
button.State = msoButtonUp
End If
End Sub
После этого в редакторе VBA необходимо создать модуль класса и поместить в него следующий код (листинг 3.105).
Public WithEvents AppEvents As Application
' Обработка события активации листа
Sub AppEvents_SheetActivate(ByVal Sh As Object)
Call CheckGridlines
End Sub
' Обработка события активации книги
Sub AppEvents_WorkbookActivate(ByVal Wb As Excel.Workbook)
Call CheckGridlines
End Sub
' Обработка события активации окна
Sub AppEvents_WindowActivate _
(ByVal Wb As Workbook, ByVal Wn As Window)
Call CheckGridlines
End Sub
В результате выполнения макроса AddCommand (после написания кода этот макрос появится в окне выбора макросов) на вкладку Надстройки будет добавлена команда Линии сетки, с помощью которой можно включать/выключать отображение сетки на текущем рабочем листе (рис. 3.42).
Рис. 3.42. Добавление команды на вкладку Надстройки
Если в данный момент сетка отображается, то возле команды Линии сетки будет установлен флажок. При выключении отображения сетки этот флажок пропадает.
Для удаления команды Линии сетки нужно выполнить макрос DeleteCommand (он также будет доступен в окне выбора макросов после написания приведенного выше кода).