Dim sheet As Object
' Отображение имен всех листов активной рабочей книги
For Each sheet In ActiveWorkbook.Sheets
MsgBox (sheet.Name)
Next
End Sub
После запуска макроса на экране отобразится такое же окно, как при выполнении предыдущего макроса. В нем будет указано название первого рабочего листа текущей книги, а затем, после каждого нажатия кнопки ОК, – названия последующих листов.
Можно ли в Excel создать бегущую строку? Да, можно, и поможет нам в этом код, приведенный в листинге 3.74.
Листинг 3.74. Создание бегущей строки
Dim intSpacesLeft As Integer ' Количество пробелов в начале
строки
Sub Start()
' Установка начального количества пробелов
intSpacesLeft = 10
' Первый вызов функции бегущей строки
MovingString
End Sub
Sub MovingString()
If intSpacesLeft >= 0 Then
' Отображение строки
Range(«A1»).Value = Space(intSpacesLeft) & «Привет!»
intSpacesLeft = intSpacesLeft – 1
' Указывем Excel, что данную процедуру нужно вызвать через _
1 секунду
Application.OnTime Now + TimeValue(«00:00:01»),
«MovingString»
End If
End Sub
После запуска макроса Start в ячейке Al будет отображаться бегущая строка с текстом Привет!.
Рассмотрим достаточно интересный трюк, с помощью которого можно заставить мигать (то есть попеременно изменять цвета) любую ячейку в течение некоторого промежутка времени.
Предположим, что нам необходима ячейка, которая 10 раз каждые 5 секунд будет изменять цвет фона с красного на зеленый. Для решения этой задачи воспользуемся следующим макросом (листинг 3.75).
Листинг 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).
Листинг 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
' Изменение направления горизонтальной скорости _
Читать дальше
Конец ознакомительного отрывка
Купить книгу