2 семестр / vba_2002

Расположение значений диапазона в произвольном порядке

Функция RANGERANTJGMIZE, представленная ниже, получает в качестве аргумента диапазон и возвращает массив, содержащий этот диапазон с произвольно переставленными значениями.

F u n c t i o n KANGERANDOMIZE(rng)

Dim V() As Variant, ValArray() As Variant Dim CellCount As Double

Dim i As Integer, j As Integer

Dim r As Integer, с As Integer

Dim Tempi As Variant, Temp2 As Variant Dim RCount As Integer, CCount As Integer Randomize

1Возвращает ошибку, если диапазон слишком большой CellCount = rng.Count

If CellCount > 1000 Then

RANGERANDOMIZE = CVErr(xlErrNA)

Exit Function

End If

1Присваивание переменных RCount = rng.Rows.Count CCount = rng.Columns.Count

ReDim V(l To RCount, 1 To CCount)

ReDim ValArrayd To 2, 1 To CellCount)

' Заполнение массива произвольными числами и значениями из rng For i = 1 То CellCount

ValArrayd, i) = Rnd ValArray(2, i) = rng(i)

Next i

' Сортировка массива ValArray по произвольным числам For i = 1 To CellCount

For j = i + 1 To CellCount

If ValArrayd, i) > ValArrayd, j) Then Tempi = ValArrayd, j)

Temp2 = ValArray(2, j) ValArray(1, j) - ValArrayd, i) ValArray(2, j) = ValArray(2, i) ValArrayd, i) = Tempi ValArray{2, i) = Temp2

End If Next j

Kext i

1Занесение произвольных значений, в массив V

i= 0

For r = 1 То RCount

For с = 1 То CCount i = i + 1

V(r, с) = ValArray(2, i) Next с

Next r RANGERANDOMIZE = V

End Function
Часть III. VisualBasicforApplications	309

Код функции RANGERANDOMIZE подобен коду функции RANDOMINTEGERS.

На рис. 11.12 показано применение функции RANGERAXTOOMIZE. В диапазон F 1 6 : I 2 5 введена такая формула массива:

(=RANGERANDOMIZE(A16:D25>}

Эта формула возвращает содержимое диапазона А16: D25, но в произвольном порядке.

Рис.11.12.ФункцияRANGERRNDQMIZEвозвращаетсодержимоедиапазонавпроизвольномпорядке

Вызов функций Windows API

Одна из самых важных возможностей VBA — поддержка функций, которые хранятся в динамически подсоединяемых библиотеках (Dynamic Link Libraries— DDL). Примеры настоящего раздела демонстрируют самые популярные функции Windows API.

Используемые объявления функций API зависят от версии Excel. Если вы попытаете применить 32-битовую функцию API в 16-битовой Excel 5, то получите ошибку. Аналогичным образом, при использовании 16-битовой функции в 32-битовой версии Excel 95 и выше также будет получена ошибка. Примеры данного раздела рассчитаны на использование 32-битовой версии Excel.

Эти и другие вопросы совместимости подробно обсуждаются в главе 25.

Определение связей с файлами

В Windows многие типы файлов ассоциируются с конкретным приложением. Эта связь позволяет загрузить файл в соответствующее приложение, дважды щелкнув мышью на файле.

Функция с названием G e t E x e c u t a b l e вызывает функцию Windows API для получения полного пути к приложению, связанному с указанным файлом. Например, в системе находится ряд файлов с расширением . t x t — вероятно, один такой файл с названием Readme, t x t в данный момент расположены в папке Windows. Функцию G e C E x e c u t a b l e можно применять для определения полного пути приложения, которое запускается при двойном щелчке на выбранном файле.

310	Глава 11. Примеры и методы программирования на VBA

Функции Windows API должны объявляться вверху модуля VBA.

PrivaCe Declare Function FindExecutableA Lib "shell32.dll"_ (ByVal lpFile As String, ByVal lpDirectory As String,_ ByVal lpResult As String) As Long

Function GetExecutable{strFile As String) As String Dim strPath As String

Dim intLen As Integer strPath = Space(255)

intLen = FindExecutableA(strFile, "\", strPath) GetExecutable = Trim{strPath)

End Function

На рис. 11.13 показан результат вызова функции GetExecutable с аргументом с: \windows\readme.txt. В данном случае этому файлу соответствует программа NOTEPAD. EXE.

Рис.11.13.Определениерасположенияприложения,

соответствующегозаданномуфайлу

Определение параметров принтера по умолчанию

В примере, приведенном в этом разделе, используется функция Windows API для получения информации об активном принтере. Данная информация содержится в одной текстовой строке. Программа разбирает эту строку и отображает информацию в более удобном для чтения формате.

Private Declare Function GetProfileStringA Lib "kernel32" _ (ByVal lpAppName As String, ByVal lpKeyName As String, _ ByVal lpDefault As String, ByVal lpReturnedString As _ String, ByVal nSize As Long) As Long

Sub DefaultPrinterlnfoO
Dim strLPT As String * 255
Dim Result As String
Call GetProfileStringA _
("Windows", "Device", "",	strLPT, 2 54)
Result = Application.Trim(strLPT)
ResultLength - Len(Result)
Commal = Application.Find{"	Result, 1)
Cornma2 = Application. Find ("	Result, Comma1 + 1)

Получение названия принтера Printer = Left(Result, Commal - 1)

Получение драйвера

Driver = Mid(Result, Commal + 1, Comma2 - Commal - 1)

Получение последней части записи об устройстве Port = Right{Result, ResultLength - Comma2)

Компоновка сообщения

ЧастьIII. VisualBasicforApplications m

Msg = "Принтер:11 & Chr{9) & Printer & Chr{13)

Msg = Msg & "Драйвер:" & Driver & Chr(13)

Msg = Msg & "Порт:" & Chr(9) & Port

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

MsgBox Msg, vblnformation, "Сведения о принтере по умолчанию" End Sub

Свойство ActivePrinter объекта Application возвращает название активного принтера (и позволяет вам его изменить). Однако не существует прямого способа определить, какой драйвер принтера или порт используется. В этом заключается польза данной функции.

На рис. 11.14 показано простое окно сообщения, полученное после выполнения этой процедуры.

Рис. 11.14. Получение информации об активном принтере с помощью функцииWindowsАР!

Определение текущего видеорежима

В данном примере функции Windows API используются для определения текущего видеорежима системы. Если в приложении необходимо отобразить определенный объем информации на одном экране, то, зная размер экрана, можно, в соответствии с этим, правильно задать масштаб текста.

1 Объявление 32-битовой API-функции

Declare Function GetSystemMetries Lib "user32" _ (ByVal nlndex As Long) As Long

Public Const SM_CXSCREEN = 0

Public Const SM_CYSCREEN = 1

Sub DisplayVideolnfo()

vidWidth = GetSystemMetrics(SM..CXSCREEN) vidHeight = GetSystemMetrics(SM_CYSCREEN)

Msg = "Текущий видеорежим: "

Msg = Msg & vidWidth & " X " & vidHeight

MsgBox Msg

End Sub

На рис. 11.15 показана окно сообщения, полученное при выполнении этой процедуры в системе с разрешением 1024x768.

РисI!•15.ИспользованиефункцииWindenvxAPIдляопределенияразрешения

Добавление звука в приложение

Excel со звуком выполняет весьма офаниченное число задач. Самое эффективное средство — это команда VBA Веер. Однако с помощью нескольких простых функций API ваше приложение сможет проигрывать файлы WAV или MIDI.

Не все системы поддерживают звукЧтоОы определить, поддерживает ли система звук, используется метод CanPlaySounds .

312	Глава 11. Примеры и методы программирования на VBA

Sub CanPlaySound()

If Not Application.CanPlaySounds Then

MsgBox "Извините, ваша система не воспроизводит звук."

End If

End Sub

Проигрывание файла WAV

Следующий пример содержит объявление функции API и простую процедуру проигрывания звукового файла с названием dogbark.wav (предполагается, что файл находится в той же папке, что и рабочая книга).

Privat e Declare Function PlaySound Lib "winmm.dll" _ Alias "PlaySoundA" (ByVal lpszName As String, _

ByVal hModule As Long, ByVal cVwFlags As Long) As Long

Const SND_SYNC = &H0

Const SND_ASYNC = &H1

Const SND_FILENAME = &Н20000

Sub PlayWAVO

WAVFile = "dogbark.wav"

WAVFile = ThisWorkbook.Path & "\" & WAVFile

Call PlaySound{WAVFile, 0&, SND_ASYNC Or SND_FILENAME) End Sub

В предыдущем примере файл WAV проигрывался несинхронно. Это озиачает, что выполнение продолжается, пока играет звук. Чтобы остановить выполнение программы иа время проигрывания файла, используйте оператор

Call PlaySound(WAVFile, 0&, SND_SYNC Or SND_FILENAME)

Проигрывание файла MIDI

Если з&уковой файл имеет формат MIDI, то необходимо применить вызов другой функции API. Файлы MIDI воспроизводит процедура PlayMIDI. Выполнение процедуры StopMlDI останавливает проигрывание файла MIDI. В данном примере применяется файл с названием xfiles . mid .

Private Declare Function mciExecute Lib "winmm.dll" _ (ByVal lpstrCommand AS String) As Long

Sub PlayMIDI()

MIDlFile = "xfiles.mid"

MIDIFile = ThisWorkbook.Path & "\" & MIDlFile mciExecute ("play " & MIDlFile)

End Sub

Sub StopMIDI{)

MIDlFile = "xfiles.mid"

MIDlFile = ThisWorkbook.Path & "\" & MIDlFile mciExecute ("stop " & MIDlFile)

End Sub

Проигрывание звука из функции рабочего листа

Функция Alarm, показанная ниже, предназначена для применений в формуле рабочего
листа. Она использует функцию Windows API, чтобы проигрывать звук, если ячейка соответ-
ствует определенному условию.
Часть III. Visual Basic forApplications	Ш

Declare Function PlaySound Lib "winmm.dll" _

Alias "PlaySoundA" (ByVal lpszName As String, _

ByVal hModule As Long, ByVal dwFlags As Long) As Long

Function ALARM(Cell, Condition)

Dim WAVFile As String

Const SND_ASYNC = &H1

Const SND_FILKNAME = &H20000

If Evaluate(Cell.Value & Condition) Then WAVFile = ThisWorkbook.Path & "\sound.wav"

Call PlaySound(WAVFile, Ob, SND_ASYNC Or SND_FILENAME| ALARM = True

Else

ALARM = False End If

End Function

Функция Alarm имеет два аргумента: ссылку на ячейку и "условие" (выраженное в виде строки). Например, следующая формула использует функцию Alarm для проигрывания файла WAV, если значение в ячейке В13 больше или равно 1000:

-ALARM<В13,- ">=1000")

Функция использует функцию VBA E v a l u a t e , чтобы определить, соответствует ли значение ячейки заданному критерию. Если условие выполнено (и звук воспроизведен), функция возвращает ИСТИНА, в противном случае она возвращает ЛОЖЬ.

Чтение и запись параметровсистемногореестра

Многие приложения Windows используют системный реестр для хранения параметров (дополнительно о реестре рассказано в главе 4). Процедуры VBA могут считывать значения из реестра и записывать в него новые значения. Для этого необходимы следующие объявления функцийWindows API.

Private Declare Function RegOpenKeyA Lib nADVAPi32.DLL" _

(ByVal hKey As Long, ByVal sSubKey As String, _ ByRef hkeyResult As Long) As Long

Private Declare Function RegCloseKey Lib "ADVAPI32.DLL" _ {ByVal hKey As Long) As Long

Private Declare Function RegSetValueExA Lib "ADVAPI32.DLL" _ (ByVal hKey As Long, ByVal sVeilueName As String, _

ByVal dwReserved As Long, ByVail dwType As Long, _ ByVal sValue As String, ByVa1 dwSize As Long) As Long

Private Declare Function RegCreatoKeyA Lib "ADVAPI32.DLL" „ (ByVal hKey As Long, ByVal sSubKey As String,

ByRef hkeyResult As Long) As Long

Private Declare Function RegQueryValueExA Lib "ADVAPI32.DLL" _ (ByVal hKey As Long, ByVal sVialueMame As String, _

ByVal dwReserved As Long, ByRef lValueType As Long, _ ByVal sValue As String, ByRef IResultLen As Long) As Long

Мноюразработаныдвефун'<ции-"оболочки", упрощающиеуправлениереестром: GetRegistry И WriteRegistry. Эти функции МОЖНО найти на Web-узле издательства. Данная рабочая книга включает процедуру, демонстрирующую чтение и записьданныхреестра.

314	Глава 11. Примеры и методы программирования на VBA

Чтение данных реестра

Функция G e t R e g i s t r y возвращает раздел из заданного места регистра. Она располагает

тремя аргументами:
RootKey	Строка, представляющая ветвь реестра, к которой обращается функ-
	ция. Данная строка может принимать одно из следующих значений:
	HKEY_CLASSES_ROOT, HKEY_C0RRENT_USER, HKEY_LOCAL_MACHINE,
	HKEY_USERS, HKEY_CURRENT_CONFIG, HKEY_DYN_DATA
Path	Полный путь к разделу реестра, к которому обращается функция
RegEntry	Название параметра, который должна получить функция
Если вам необходимо узнать текущий цвет.строки заголовка активного окна, то исполь-
зуйте функцию G e t R e g i s t r y следующим образом (обратите внимание, что аргументы не
чувствительны к регистру):
RootKey = "hkey_current_user"
Path =	"Control Panel\Colors"
RegEntry = "ActiveTitle"
MsgBox GetRegistry(RootKey, Path, RegEntry), _
vblnformation, Path & "\RegEntry"
В окне сообщения будет отображено три значения, представляющие цвета в модели RGB.
Записьданныхв реестр
Функция WriteRegistry записывает значение в указанный раздел реестра. Если операция
завершается успешно, функция возвращает ИСТИНА; в противном случае функция возвращает
ЛОЖЬ. Функция WriteRegistry получает следующие аргументы (все они являются строками).
RootKey	Строка, представляющая ветвь реестра, к которой обращается функция. Эта
	строка может принимать одно из перечисленных далее значений:
	HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, HKEY_LOCAL_MACHINE,
	HKEY_USERS, HKEY_CURRENT_CONFIG, HKEY_DYN_DATA
Path	Полный путь в реестре. Если путь не существует, он будет создан
RegEntry	Название раздела реестра, в который записывается значение. Если раздел не
	существует, он добавляется в реестр
RegVal	Значение, которое записывается в реестр
Ниже приведен пример, в котором записывается значение, представляющее время и дату
запуска Excel. Эта информация сохраняется в разделе настроек Excel.
Sub Auto_Open()
RootKey = "hkey_current_user"
Path =	"software\microsoft\office\10.O\excel\LastStarted"
RegEntry = "DateTime"
RegVal = Now<)
If WriteRegistryfRootKey, Path, RegEntry, RegVal) Then
msg = RegVal & " сохранено в реестре."
	Else msg = "Произошла ошибка"
End If
MsgBox msg
End Sub
Часть III. Visual Basic for Applications		315

Если вы сохраните эту подпрограмму в личной книге макросов, то указанный параметр будет автоматически обновляться при каждом запуске Excel.

Резюме

В этой главе рассматриваются примеры, которые помогут вам лучше разобраться в возможностях VBA.

Следующая глава посвящена отдельному классу приложений Excel — утилитам.

316	Глава 11. Примеры и методы программирования на VBA

Работа с пользовательскими формами

В четырех главах	этой части рассматриваются диало-
говые окна,	создаваемые пользователем (они извест-

ны под названием пользовательских форм или UserForm). Глава 12 предлагает описание альтернативных методов отображения диалоговых окон. В главе 13 вы ознакомитесь с использованием форм UserForm, узнаете о различных элементах управления, которые можно на них располагать. В главах 14 и 15 приведен ряд примеров готовых диалоговых окон — от самых простых до невероятно сложных.

Создание

собственных диалоговых окон

Диалоговые окна, возможно, являются самым важным элементом пользовательского интерфейса в программах Windows. Практически все программы в системе Windows

используют такие окна. Кроме того, многие пользователи знакомы с принципами управления диалоговыми окнами. Разработчики, создающие приложения Excel, могут программировать собственные диалоговые окна с помощью объектов UserForm.

Перед тем, как приступить к изучению тонкостей создания диалоговых окон на основе пользовательских форм U s e r - Form, вам стоит научиться использовать некоторые встроенные инструменты Excel, предназначенные для вывода диалоговых окон. Данная тема является основной в настоящей главе.

Перед созданием

диалоговых окон...

В некоторых случаях можно избежать создания собственного диалогового окна. Воспользуйтесь одним из нескольких встроенных окон:

•окном ввода данных;

•окном сообщения;

•окном выбора файла;

•окном ввода имени файла и его расположения при сохранении;

•окном выбора папки;

•окном запроса данных.

Эти диалоговые окна будут рассматриваться в следующих разделах.