If .Left + alngHorzSpeed(i) < intLeftBorder Then
' Корректировка положения
.Left = intLeftBorder
' Изменение направления горизонтальной скорости _
на противоположное
alngHorzSpeed(i) = -alngHorzSpeed(i)
End If
' Контроль достижения нижней границы ячейки
If .Top + .Height + alngVertSpeed(i) >
intBottomBorder Then
' Корректировка положения
.Top = intBottomBorder – .Height
' Изменение направления вертикальной скорости _
на противоположное
alngVertSpeed(i) = -alngVertSpeed(i)
End If
' Контроль достижения верхней границы ячейки
If .Top + alngVertSpeed(i) < intTopBorder Then
' Корректировка положения
.Top = intTopBorder
' Изменение направления вертикальной скорости _
на противоположное
alngVertSpeed(i) = -alngVertSpeed(i)
End If
' Перемещение автофигуры
.Left = .Left + alngHorzSpeed(i)
.Top = .Top + alngVertSpeed(i)
' Вращение автофигуры (изменение направления вращения _
происходит каждый раз при изменении направления _
вертикального перемещения)
.IncrementRotation alngVertSpeed(i)
' Даем Excel команду обработать пользовательский ввод
DoEvents
End With
Next
Loop
End Sub
Теперь в ячейке B2 нужно создать две любые автофигуры (перед этим ячейку В2 следует существенно увеличить, сделав ее размером примерно с четверть экрана, чтобы было место для вращения автофигур).
Примечание
Адрес ячейки можно устанавливать любой, но для этого необходимо внести соответствующие изменения в код макроса.
Теперь, запустив созданный макрос, полюбуйтесь результатом своей работы – автофигуры будут вращаться и одновременно перемещаться в пределах указанной ячейки. При желании можно раскрасить автофигуры в разные цвета и установить какой-нибудь фон для ячейки.
Вызов таблицы цветов
При необходимости можно вывести на экран таблицу цветов и соответствующих значений свойства Colorlndex (данное свойство задает индексированный цвет заливки в соответствии с палитрой цветов). Для этого создадим и запустим следующий макрос (листинг 3.77).
Sub ShowColorTable()
Dim intColor As Integer
' Формирование заголовка таблицы
Range(«A1»).Value = «Цвет»
Range(«B1»).Value = «Значение свойства ColorIndex»
' Вывод таблицы
Range(«A2»).Select
For intColor = 1 To 56
' Окрашиваем ячейку столбца "A" в текущий цвет
With ActiveCell.Interior
.ColorIndex = intColor
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
' В ячейку столбца "B" вносим индекс текущего цвета
ActiveCell.Offset(0, 1).Value = intColor
' Переходим на следующую строку
ActiveCell.Offset(1, 0).Activate
Next
' Покажем ячейку «A1» (начало таблицы)
Range(«A1»).Select
ActiveWindow.ScrollRow = 1
End Sub
В результате выполнения макроса откроется таблица, изображенная на рис. 3.24.
Рис. 3.24. Таблица цветов
В столбце А данной таблицы отображается перечень цветов, а в столбце В – соответствующие им значения свойства Colorlndex. На рисунке показан лишь фрагмент таблицы, поскольку полностью она состоит из 56 строк.
Создание калькулятора
Используя средства языка VBA, можно быстро создать простейший калькулятор, предназначенный для вычисления значений арифметических выражений. Пример макроса, который позволяет это сделать, приведен в листинге 3.78.
Sub SimpleCalculator()
Dim strExpr As String
' Ввод выражения
strExpr = InputBox(«Что будем считать?»)
' Подсчет и вывод результата
MsgBox strExpr & " = " & Application.Evaluate(strExpr)
End Sub
После выполнения данного макроса появится окно, изображенное на рис. 3.25.
Рис. 3.25. Калькулятор
В данном окне с клавиатуры следует ввести выражение, значение которого необходимо вычислить, и нажать кнопку ОК либо клавишу Enter. Результат расчета будет показан в информационном окне (рис. 3.26).
Рис. 3.26. Результат расчета
Если строку макроса strExpr = InputBox («Что будем считать?») написать в виде, например, strExpr = InputBox («Быстрое вычисление»), то окно ввода выражения будет выглядеть, как на рис. 3.27.
Рис. 3.27. Замена текста
Окно результата расчета при этом не изменится (рис. 3.28).
Рис. 3.28. Окно результата расчета
Еще о создании пользовательских меню
Мы уже рассматривали некоторые способы создания пользовательского меню (см. выше раздел «Формирование пользовательского меню»). Предлагаемый же в данном разделе пример является более масштабным, потому что в нем можно увидеть команды созданного меню «в работе» (то есть при выполнении команды на экране отобразится определенный результат).
Сначала рассмотрим создание пользовательского меню, которое полностью состоит из пользовательских команд. После этого реализуем меню, в котором наряду с пользовательскими будут и штатные средства Excel.
Меню с пользовательскими командами
Для реализации данного трюка нам потребуется создать два кода. Один из них будет помещен в модуль ЭтаКнига, а другой – в стандартный модуль. Первый код выглядит следующим образом (листинг 3.79).
Sub Workbook_Open()
' Задание имени меню
strMenuName = «MyCommandBarName»
' Создание меню
CreateCustomMenu
End Sub
Sub Workbook_BeforeClose(Cancel As Boolean)
' Удаление меню перед закрытием книги
DeleteCustomMenu
End Sub
Второй код необходимо набрать в любом стандартном модуле. В нем определяется структура пользовательского меню и порядок его работы. Содержимое данного кода представлено в листинге 3.80.
Public strMenuName As String ' Имя строки меню
Private cbrcBar As CommandBarControl
Sub CreateCustomMenu()
Dim cbrMenu As CommandBar
Dim cbrcMenu As CommandBarControl ' Выпадающее меню «Меню»
Dim cbrcSubMenu As CommandBarControl ' Выпадающее меню
«Дополнительно»
' Если уже есть пользовательское меню, то оно удаляется
DeleteCustomMenu
' Создание меню вместо стандартного
Set cbrMenu = Application.CommandBars.Add(strMenuName,
msoBarTop, _
True, True)
' Создание выпадающего меню с названием «Меню»
Set cbrcMenu = cbrMenu.Controls.Add(msoControlPopup, , , ,
True)
With cbrcMenu
.Caption = «&Меню»
End With
' Создание пункта меню
With cbrcMenu.Controls.Add(Type:=msoControlButton, _
Temporary:=True)
.Caption = «&Меню1»
.OnAction = «CallMenu1»
End With
' Создание пункта меню
With cbrcMenu.Controls.Add(Type:=msoControlButton, _
Temporary:=True)
.Caption = «Меню2»
.OnAction = «CallMenu2»
End With
' Создание подменю первого уровня
Set cbrcSubMenu = cbrcMenu.Controls.Add(Type:=msoControlPopup, _
Temporary:=True)
With cbrcSubMenu
.Caption = «Подменю1»
.BeginGroup = True
End With
' Создание пункта меню
With cbrcMenu.Controls.Add(Type:=msoControlButton, _
Temporary:=True)
.Caption = «Вкл/Выкл»
.OnAction = «MenuOnOff»
.Style = msoButtonIconAndCaption
.FaceId = 463
End With
' Создание пункта меню в подменю первого уровня
With cbrcSubMenu.Controls.Add(Type:=msoControlButton, _
Temporary:=True)
.Caption = «Подменю1»
.OnAction = «CallSubMenu1»
.Style = msoButtonIconAndCaption
.FaceId = 2950
.State = msoButtonDown
End With
' Cоздание пункта меню в подменю первого уровня (его состояние _
изменяется посредством пункта «Вкл/Выкл»), для чего сохраним ссылку _
на созданный пункт меню
Set cbrcBar = cbrcSubMenu.Controls.Add(Type:=msoControlButton, _
Temporary:=True)
With cbrcBar
.Caption = «Подменю2»
.OnAction = «CallSubMenu2»
“ Сначала меню деактивировано
.Enabled = False
End With
' Создание подменю второго уровня
Set cbrcSubMenu = cbrcSubMenu.Controls.Add(Type:=msoControlPopup, _
Temporary:=True)
With cbrcSubMenu
.Caption = «ПодчПодменю1»
.BeginGroup = True
End With
' Cоздание пункта меню в подменю второго уровня
With cbrcSubMenu.Controls.Add(Type:=msoControlButton, _
Temporary:=True)
.Caption = «ПослМеню1»
.OnAction = «CallLastMenu1»
.Style = msoButtonIconAndCaption
.FaceId = 71
.State = msoButtonDown
End With
' Cоздание пункта меню в подменю второго уровня
With cbrcSubMenu.Controls.Add(Type:=msoControlButton, _
Temporary:=True)
.Caption = «ПослМеню2»
.OnAction = «CallLastMenu2»
.Style = msoButtonIconAndCaption
.FaceId = 72
.Enabled = True
End With
' Отображение меню
cbrMenu.Visible = True
Set cbrcSubMenu = Nothing
Set cbrcMenu = Nothing
Set cbrMenu = Nothing
End Sub
Sub DeleteCustomMenu()
' Удаление строки меню
On Error Resume Next
Application.CommandBars(strMenuName).Delete
On Error GoTo 0
End Sub
Sub CallMenu1()
' Обработка вызова Меню1
MsgBox «Приветствует меню 1!», vbInformation,
ThisWorkbook.Name
End Sub
Sub CallMenu2()
' Обработка вызова Меню2
MsgBox «Приветствует меню 2!», vbInformation,
ThisWorkbook.Name
End Sub
Sub CallSubMenu1()
' Обработка вызова Подменю1
MsgBox «Приветствует подменю 1!», vbInformation,
ThisWorkbook.Name
End Sub
Sub CallSubMenu2()
' Обработка вызова Подменю1
MsgBox «Приветствует подменю 2!», vbInformation,
ThisWorkbook.Name
End Sub
Sub CallLastMenu1()
' Обработка вызова Последнего меню1
MsgBox «Приветствует последнее меню 1!», vbInformation,
ThisWorkbook.Name
End Sub
Sub CallLastMenu2()
' Обработка вызова Последнего меню2
MsgBox «Приветствует последнее меню 2!», vbInformation,
ThisWorkbook.Name
End Sub
Sub MenuOnOff()
' Активация или деактивация пункта «Меню-Подменю1-Подменю2»
cbrcBar.Enabled = Not cbrcBar.Enabled
End Sub
Чтобы пользовательское меню отобразилось на вкладке Надстройки, необходимо запустить макрос CreateCustomMenu (после написания кода данный макрос будет доступен в окне выбора макросов). Результат представлен на рис. 3.29.
Рис. 3.29. Созданное пользовательское меню
Данное меню работает следующим образом: при выполнении любой его команды появляется окно с соответствующим сообщением (рис. 3.30). Исключение составляет команда Вкл/Выкл – с ее помощью осуществляется включение/выключение пункта Подменю1 → Подменю2.
Рис. 3.30. Результат выбора пункта Меню1
Чтобы вернуться в первоначальное состояние, необходимо воспользоваться макросом DeleteCustomMenu (в некоторых случаях для «отката» нужно закрыть рабочую книгу, затем вновь открыть ее и лишь после этого запустить макрос DeleteCustomMenu). Однако проще сделать по-другому: нужно щелкнуть правой кнопкой мыши на созданном меню и в открывшемся контекстном меню выполнить команду Удалить настраиваемую панель инструментов, после чего подтвердить удаление.
Меню со стандартными командами
В данном подразделе мы создадим пользовательское меню, которое будет включать в себя меню Файл (это меню будет соответствовать стандартному меню Файл из Excel более ранних версий) и меню Дополнительно.
Для реализации поставленной задачи необходимо в стандартном модуле редактора VBA написать код, представленный в листинге 3.81.
Sub CreateMenu()
Dim cbrMenu As CommandBar
Dim cbrcNewMenu As CommandBarControl
' Удаление меню, если оно уже есть
Call DeleteMenu
' Добавление строки пользовательского меню
Set cbrMenu = CommandBars.Add(MenuBar:=True)
With cbrMenu
.Name = «Моя строка меню»
.Visible = True
End With
' Копирование стандартного меню «Файл»
CommandBars(«Worksheet Menu Bar»).FindControl(ID:=30002).Copy _
CommandBars(«Моя строка меню»)
' Добавление нового меню – «Дополнительно»
Set cbrcNewMenu = cbrMenu.Controls.Add(msoControlPopup)
cbrcNewMenu.Caption = «&Дополнительно»
' Добавление команды в новое меню
With cbrcNewMenu.Controls.Add(msoControlButton)
.Caption = «&Восстановить обычную строку меню»
.OnAction = «DeleteMenu»
End With
' Добавление команды в новое меню
With cbrcNewMenu.Controls.Add(Type:=msoControlButton)
.Caption = «&Справка»
End With
End Sub
Sub DeleteMenu()
' Пытаемся удалить меню (успешно, если оно ранее создано)
On Error Resume Next
CommandBars(«Моя строка меню»).Delete
On Error GoTo 0
End Sub
В результате написания данного кода будет создан макрос CreateMenu. При его выполнении на вкладке Надстройки появится пользовательское меню, включающее в себя пункты Файл (этот пункт будет соответствовать стандартному меню Файл из Excel более ранниз версий) и Дополнительно. С помощью команды Дополнительно → Восстановить обычную строку меню созданное меню будет удалено. Команда Дополнительно → Справка имеет чисто демонстрационную функцию.