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

Что открыто в данный момент?

Вывод разрешения монитора

Вывод результата расчетов в отдельном окне

Вывод информации о текущем документе

Вызов окна настройки шрифта

Листинг 3.70. Окно настройки шрифта

Sub ShowFontDialog()

' Вызов стандартного окна настройки шрифта текущей ячейки

Application.Dialogs(xlDialogActiveCellFont).Show

End Sub

Листинг 3.71. Информация о текущем документе

Sub ShowInfo()

Dim i As Integer

' Выводим имя файла рабочей книги

Range("A1") = ActiveWorkbook.Name

' Выводим имя текущего листа

Range("B1") = ActiveSheet.Name

' Выводим номера листов

For i = 1 To ActiveWorkbook.Sheets.Count

ActiveSheet.Cells(i, 3) = i

Next i

End Sub

Листинг 3.72. Окно с результатом расчетов

Sub ResultToWindow()

' Переходим на первый лист

Worksheets(1).Activate

' Заносим в ячейки данные

Range("A2") = 5

Range("A3") = "=A2+3"

' Выводим результат расчета

MsgBox Range("A3").Formula + " = " + str(Range("A3").Value)

End Sub

Листинг 3.73. Разрешение монитора

'Объявление API-функции

Declare Function GetSystemMetrics Lib "user32" _

(ByVal nIndex As Long) As Long

' Константы, которые передаются в функцию для определения _

горизонтального и вертикального размеров изображения

Const SM_CXSCREEN = 0

Const SM_CYSCREEN = 1

Sub GetMonitorResolution()

Dim lngHorzRes As Long

Dim lngVertRes As Long

' Получение ширины и высоты изображения на мониторе

lngHorzRes = GetSystemMetrics(SM_CXSCREEN)

lngVertRes = GetSystemMetrics(SM_CYSCREEN)

' Отображение сообщения

MsgBox "Текущее разрешение: " & lngHorzRes & "x" & lngVertRes

End Sub

Листинг 3.74. Открытые файлы

Sub WorkBooksList()

Dim book As Object

' Вывод имени каждой рабочей книги

For Each book In Workbooks

MsgBox (book.Name)

Next

End Sub

Листинг 3.75. «Перелистывание» книги

Sub SheetsOfBook()

Dim sheet As Object

' Отображение имен всех листов активной рабочей книги

For Each sheet In ActiveWorkbook.Sheets

MsgBox (sheet.Name)

Next

End Sub

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

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

Дата добавления: 2015-06-25