Excel. Трюки и эффекты | страница 124
Предположим, что нам необходима ячейка, которая 10 раз каждые 5 секунд будет изменять цвет фона с красного на зеленый. Для решения этой задачи воспользуемся следующим макросом (листинг 3.75).
Sub BlinkingCell()
Static intCalls As Integer ' Счетчик количества миганий
' Если ячейка мигала менее 10 раз, то изменим _
в очередной раз ее цвет
If intCalls < 10 Then
intCalls = intCalls + 1
' Определение, какой цвет необходимо установить
If Range(«A1»).Interior.Color <> RGB(255, 0, 0) Then
' Цвет ячейки не красный, так что теперь назначим _
именно красный цвет
Range(«A1»).Interior.Color = RGB(255, 0, 0)
Else
' Назначим ячейке зеленый цвет
Range(«A1»).Interior.Color = RGB(0, 255, 0)
End If
' Эту процедуру необходимо вызвать через 5 секунд
Application.OnTime Now + TimeValue(«00:00:05»),
«BlinkingCell»
Else
' Хватит мигать
Range(«A1»).Interior.ColorIndex = xlNone
intCalls = 0
End If
End Sub
После запуска макроса BlinkingCell будет мигать ячейка Al. Путем внесения соответствующих изменений в приведенный макрос можно регулировать продолжительность цикла и изменять цвета фона по своему усмотрению.
Вращающиеся автофигуры
Можно ли заставить автофигуры вращаться? Оказывается, можно, и это вовсе не так сложно, как кажется на первый взгляд. В этом разделе мы рассмотрим, каким образом можно заставить перемещаться с одновременным вращением сразу две автофигуры.
Для реализации данного трюка нам нужно в первую очередь написать макрос, код которого представлен в листинге 3.76 (этот код нужно поместить в стандартный модуль редактора VBA).
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)
' Заполнение массива скоростей: