Мигающая ячейка

Листинг 3.78. Мигание ячейки

Sub BlinkingCell()

Static intCalls As Integer ' Счетчик количества миганий

' Если ячейка мигала менее 10 раз, то изменим _

в очередной раз ее цвет

IfintCalls< 10Then

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)

EndIf

' Эту процедуру необходимо вызвать через 5 секунд

Application.OnTime Now + TimeValue("00:00:05"), "BlinkingCell"

Else

' Хватит мигать

Range("A1").Interior.ColorIndex = xlNone

intCalls = 0

End If

End Sub

Вращающиеся автофигуры

Листинг 3.79.Вращение автофигур

SubRotatingAutoShapes()

StaticfRunningAsBoolean

' Проверка, выполняется ли уже этот макрос

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