Информатика. Книга 7 Быстрое размножение рабочей книги 7 Сохранение рабочей книги с именем, представляющим собой текущую дату 7

• Название: Книга 7 Быстрое размножение рабочей книги 7 Сохранение рабочей книги с именем, представляющим собой текущую дату 7
• Анкор: Информатика
• Дата: 16.05.2022
• Размер: 1.27 Mb.
• Имя файла: VBA_v_primerakh.doc
• Тип: Книга; #532661
• страница: 13 из 21

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

Листинг 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

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

Листинг 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