Вращающиеся автофигуры
Можно ли заставить автофигуры вращаться? Оказывается, можно, и это вовсе не так сложно, как кажется на первый взгляд. В этом разделе мы рассмотрим, каким образом можно заставить перемещаться с одновременным вращением сразу две автофигуры.
Для реализации данного трюка нам нужно в первую очередь написать макрос, код которого представлен в листинге 3.76 (этот код нужно поместить в стандартный модуль редактора VBA).
Листинг 3.76. Вращение автофигур
Sub RotatingAutoShapes()
Static fRunning As Boolean
' Проверка, выполняется ли уже этот макрос
If fRunning Then
' При повторном запуске останавливаем все запущенные макросы
fRunning = False
End
End If
' Укажем, что макрос запущен
fRunning = True
Dim cell As Range ' Рабочая ячейка
Dim intLeftBorder As Long ' Левая граница ячейки
Dim intRightBorder As Long ' Правая граница ячейки
Dim intTopBorder As Long ' Верхняя граница ячейки
Dim intBottomBorder As Long ' Нижняя граница ячейки
Dim alngVertSpeed(1 To 2) As Long ' Массивы со значениями
Dim alngHorzSpeed(1 To 2) As Long ' горизонтальной и вертикальной
' составляющих скоростей
фигур
Dim ashShapes(1 To 2) As Shape ' Массив перемещаемых
автофигур
Dim i As Integer
' Заполнение массива автофигур
Set ashShapes(1) = ActiveSheet.shapes(1)
Set ashShapes(2) = ActiveSheet.shapes(2)
' Заполнение массива скоростей:
' для первой фигуры
alngVertSpeed(1) = 3
alngHorzSpeed(1) = 3
' для второй фигуры
alngVertSpeed(2) = 4
alngHorzSpeed(2) = 4
' Получение границ рабочей ячейки
Set cell = Range(«B2»)
intLeftBorder = cell.Left
intRightBorder = cell.Left + cell.Width
intTopBorder = cell.Top
intBottomBorder = cell.Top + cell.Height
' Выполнение вращения и перемещения фигур
Do
' Изменение положения каждой автофигуры
For i = 1 To 2
With ashShapes(i)
' Контроль достижения правой границы ячейки
If .Left + .Width + alngHorzSpeed(i) >
intRightBorder Then
' Корректировка положения
.Left = intRightBorder – .Width
' Изменение направления горизонтальной скорости _
на противоположное
alngHorzSpeed(i) = -alngHorzSpeed(i)
End If
' Контроль достижения левой границы ячейки
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 следует существенно увеличить, сделав ее размером примерно с четверть экрана, чтобы было место для вращения автофигур).
Примечание
Адрес ячейки можно устанавливать любой, но для этого необходимо внести соответствующие изменения в код макроса.
Теперь, запустив созданный макрос, полюбуйтесь результатом своей работы – автофигуры будут вращаться и одновременно перемещаться в пределах указанной ячейки. При желании можно раскрасить автофигуры в разные цвета и установить какой-нибудь фон для ячейки.