Создание бегущей картинки

Листинг 3.77. Бегущая картинка

Sub MovingImage()

Dim i As Integer

Dim image As Object

' Создание изображения (в ячейке "A1")

With Range("A1")

' Формирование значения в ячейке:

' текст

.Value = "Привет!"

' полужирный шрифт

.Font.Bold = True

' цвет

.Font.Color = RGB(233, 133, 229)

' размер шрифта

.Font.Size = 16

' угол наклона

.Orientation = 30

' Отображение текста полностью

.EntireColumn.AutoFit

' Копирование в буфер обмена

.Copy

' Создание самостоятельного изображения (на основе _

скопированных в буфер обмена данных)

Set image = ActiveSheet.Pictures.Paste(Link:=False)

' Содержимое ячейки больше не нужно

.Clear

End With

' Задание начального положения изображения (левый верхний _

угол листа)

With image

.Top = 0

.Left = 0

End With

MsgBox "ПУСК!"

With image

' Перемещение изображения по диагонали

For i = 0 To 100

.Top = i

.Left = i

Next

' Удаление изображения

.Delete

End With

' Удаление ссылки на изображение

Set image = Nothing

End Sub

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

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

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