2 семестр / vba_2002

Определение количества страниц для печати

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

Sub PageCount()

MsgBox (ActiveSheet.HPageBreaks.Count + 1) * _ (ActiveSheet-VPageBreaks.Count + I)

End Sub

Представленная ниже процедура VBA циклически просматривает все листы в активной рабочей книге и отображает общее количество страниц для печати.

Sub ShowPageCount()

Dim PageCount As Integer Dim sht As Worksheet PageCount = 0

For Each sht In Worksheets

PageCount = PageCount + (sht.HPageBreaks.count + 1 ) * _ (sht.VPageBreaks.Count + 1)

Next sht

MsgBox "Всего страниц = " & PageCount End Sub

Отображение даты и времени

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

Процедура DateAndTime отображает окно сообщения с текущей датой и временем (рис. 11.9). В этом примере в строке заголовка окна сообщения представлено пользовательское сообщение.

Процедура, приведенная в листинге 11.7, использует в качестве аргумента функции Format функцию Date . В результате строка с датой будет представлена в удобном для восприятия формате. Тот же прием применяется для задания формата времени.

Рис.11.9.Окносообщения,отображающеедатуивремя

Листинг 11.7. Отображениетекущейдатыитекущеговремени

Sub DateAndTime()

TheDate = Format(Date, "Long Date")

TheTime = Format(Time, "Medium Time")

1Определение приветствия в зависимости от времени суток Select Case Time

Case Is < Tin\eValue{ "12:00"): Greeting = "Доброе утро. Case Is >= TimeValue("17:00"): Greeting = "Добрый день. Case Else: Greeting = "Добрый вечер, "

End select

'Присоединение к приветствию имени пользователя

Часть III. Visual Basic for Applications

289

FullName = Application.UserName

SpacelnName = InStrd, FullName, " ", 1}

' Обработка ситуации, когда в имени нет пробела

If SpacelnName = 0 Then SpacelnName = Len(FullName) FirstName = Left(FullName, SpacelnName)

Greeting = Greeting & FirstName

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

MsgBox TheDate & vbCrLf & TheTime, vbOKOnly, Greeting

End Sub

Вданном примере использованы именованные форматы ("Long Date" и "Medium Time")

сцелью обеспечить нормальную работу макроса независимо от региональных настроек компьютера пользователя, Однако вы можете обратиться к другим форматам. Например, чтобы отобразить дату в формате мм/дд/гг, воспользуйтесь следующим оператором:

TheDate = F o r m a t ( D a t e , "mm/dd/yy"

Чтобы построить в зависимости от времени суток приветствие, которое отображается в строке заголовка, используется конструкция S e l e c t Case. Значения времени задаются в VBA так же, как в Excel. Если время меньше 0,5 (полдень), то это утро. Если время больше 0,7083 (5 часов вечера), то это вечер. Все остальное время — это лень. Мы выбрали легкий способ и использовали функцию VBA TimeValue, которая возвращает значение времени из строки.

Следующие операторы определяют имя пользователя, указанное на вкладке Общие диалогового окна Параметры. Для нахождения первого пробела в имени пользователя использована функция VBA I n S t r . Когда я создавал рассматриваемую процедуру в первый раз, то не учел, что в имени пользователя пробел может отсутствовать. Поэтому, когда процедура была запущена в компьютере с именем пользователем Nobody, программа выдала ошибку — из чего следует, что нельзя предусмотреть все, и даже самые простые процедуры могут дать сбой. (Кстати говоря, если поле введения имени пользователя не заполнено, то Excel всегда использует значение User). Решение этой проблемы— присваивать переменной SpacelnName длину полного имени пользователя, тогда функция L e f t извлекает полное имя.

Функция MsgBox объединяет дату и время, но использует встроенную константу vbCrLf для вставки между ними разрыва строки. vbOKOnly — предопределенная константа, возвращающая 0; в результате окно сообщения содержит только кнопку ОК. Последний аргумент — приветствие G r e e t i n g , составленное ранее в процедуре.

Получение списка шрифтов

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

Следующая процедура отображает список установленных шрифтов в столбце А активного рабочего листа. Используется метод F o n t C o n r o l для обращения к элементу управления Шрифт на панели инструментов Форматирование. Если такой элемент управления не найден (например, пользователь его удалил), то создается временная панель инструментов CommandBar, на которую добавляется элемент управления Шрифт.

Дополнительную информацию о работе с элементами управления CommandBar вы найдете в главе 22.

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

Sub ShowInstalledFonts()

Dim FontList As CommandBarControl

Dim TempBar As CommandBar

Dim i As Integer

Set FontList = Application.CommandBars("Formatting"). _

FindControl(ID:=1728)

1Если элемент Шрифт не отображен, создается временная панель If FontList Is Nothing Then

Set TempBar = Application.CommandBars.Add

Set FontList = TempBar.Controls.Add(ID:=1728)

End If

1Помещение шрифтов в столбец А Range("A:A").ClearContents

For i = 0 To FontList.ListCount - 1

Cells(i + 1, 1) = FontList.List(i + 1)

Next i

' Удаление временной панели, если она существует On Error Resume Next

TempBar.Delete End Sub

Сортировка массива

Несмотря на то, что в Excel существует встроенная команда сортировки ячеек, в VBA метод сортировки массивов не представлен. Один возможный, но достаточно громоздкий вариант решить эту задачу — перенести массив в диапазон ячеек на рабочем листе, отсортировать данные с помощью команд Excel, а затем занести результат обратно в массив. Однако если в вашей программе имеет большое значение скорость выполнения операции, то лучше написать на VBA процедуру сортировки.

В данном разделе рассматривается несколько методов сортировки.

•Сортировка на рабочем листе. Массив переносится на рабочий лист Excel; диапазон на рабочем листе сортируется и переносится обратно в массив. Единственным аргументом этой процедуры является массив. Работа может производиться с массивами не более чем из 65536 элементов (количество строк в рабочем листе).

•Пузырьковый метод — довольно простой прием сортировки (он использовался в примере сортировки листов в главе 9). Его несложно запрограммировать, однако такой алгоритм сортировки не самый эффективный, особенно для большого количества элементов в массиве.

•Быстрая сортировка. Намного более быстрая процедура, чем пузырьковый алгоритм, но, чтобы в ней разобраться, потребуется время.

•Метод пересчета. Работает очень быстро, но для его улучшения также потребуется время и определенные усилия.

На Web-узле издательства содержится приложение рабочей книги, демонстрирующее эти методы сортировки. Такую рабочую книгу интересно протестировать на массивах разного размера.

Часть III. VisualBasicforApplications

291

На рис. 11,10 показано диалоговое окно для этого проекта. После тестирования процедуры сортировки на семи массивах разного размера (начиная со 100 и оканчивая 100000 элементов); элементами массивов выступали произвольные числа (типа Double).

Рис. JhlO. Сравнениевремени, необходимого для выполнений сортировки массивов различногоразмера

В табл. 11.1 представлены результаты теста. Выражение 0,00 означает, что сортировка произошла за время, меньшее, чем 0,01 секунды.

Таблица 11.1. Время сортировки в секундах для четырех алгоритмов, полученное для массивов с разным количеством элементов

Элементы	Сортировка на рабо-	Пузырьковая сорти-	Быстрая сортировка	Сортировка мето-
массива	чем листе Excel	ровка V3A	УВД	дом пересчета VBA
100	0,05	0,00	0,05	0,00
500	0,06	0,11	0,05	0,00
1000	0,11	0,44	0,11	0,00
5000	0,55	8,89	0,77	0,05
10000	1.16	31,69	1,75	0,06
50000	6,98	788,62	10,21	0,22
100000	-		20,60	0,44
Далее проведем вторую серию тестов на массиве, который был почти полностью отсор-
тирован. Результаты показаны в табл. 11.2.
Таблица 11.2. Время сортировки в секундах для четырех алгоритмов сортировки
на примере практически отсортированных массивов
Элементы	Сортировка на рабо-	Пузырьковая сорт-	Быстрая сортиров-	Сортировка методом
массива	чем листе Excel	ровка VBA	KaVBA	пересчета VBA
100	0,05	0,00	0,00	0,00
500	0.05	0,11	0,00	0,00
1000	0,11	0,27	0,11	0,00
5000	0,33	7,09	0,55	0,05
10000	1.15	32,02	1,70	0,06
50000	3,35	718,52	9,23	0,22
100000	-	-	20,60	0,44
292	Глава 11. Примеры и методы программирования на VBA

Как видно, на алгоритмы не оказывает особого влияния то, каким образом отсортированы элементы массива: находятся они в произвольном порядке или частично отсортированы.

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

Обработка последовательности файлов

Одной из главных причин использования макросов является многократное повторение определенной операции. Пример в листинге П.8 показывает, как выполнить макрос в нескольких разных файлах, сохраненных на диске. Этот пример, который призван помочь вам написать собственную программу выполнения этой задачи, запрашивает у пользователя сведения о файле и обрабатывает соответствующие запросу рабочие книги. В рассматриваемом случае обработка состоит из импорта файла и ввода ряда формул суммирования, описывгчощих данные в файле.

Листинг11.8.Макрос,обрабатывающийнесколькофайловнадиске

Sub BatchProcess{)

Dim FS As FileSearch

Dim FilePath As String, FileSpec As String

Dim i As Integer

1Определение пути и сведений о файле FilePath = Thisworkbook.Path & "\" FileSpec = "text77.txt"

1Создание объекта FileSearch

Set FS = Application.FileSearch With FS

.WewSearch

.Lookln = FilePath -FileName = FileSpec

.Execute

1Выход, если файлы не найдены If -FoundFiles-Count = 0 Then

MsgBox "No files were found"

Exit Sub

End If

End With

1Просмотр и обработка файлов

For i = 1 То FS.FoundFiles.Count

Call ProcessFiles(FS.FoundFiles(i))

Next i

End Sub

В этом примере используется три дополнительных файла, которые также можно найти на Web-узле: TextOl. t x t , TextO2 . t x t и TextO3 . t x t . Вам необходимо будет изменить процедуру, чтобы она позволила импортировать другие текстовые файлы. Эта процедура использует объект FileSearch, поэтому она работает в версиях Excel 2000 и выше.

Часть Ш. Visual Basic for Applications

293

Соответствующие заданному критерию файлы получает объект FileSearch, а процедура использует для обработки файлов цикл For-Next. В цикле обработка выполняется процедурой ProcessFiles, показанной ниже. Эта простая процедура использует метод OpenText для импорта файла и вставки в него пяти формул. Конечно, вы можете заменить эту процедуру собственной, соответствующей более конкретной задаче.

Sub	ProcessFiles (FileNeune As string)
1	Импорт файла
	Workbooks.OpenText Filename:=FileMame, _
	Origin:=xlWindows,__
	StartRow:=l, _
	DataType:=xlFixedWid£h, _
	Fieldln£o:=
	Array(Array(0, 1), Array{3, 1), Array(12, 1J)
1	Ввод формул суммирования
	Range("Dl").Value = "A"
	Range("D2").
	Range("D3").Va1U'
	Range {"El :E3") .F<
	Range("F1:F3") .

End Sub

Функции, полезные для использования

впрограммах VBA

Вданном разделе представлены некоторые "практичные" функции, которые могут использоваться в ваших собственных приложениях либо предоставить подсказку для создания аналогичных функций. Эти функции наиболее полезны, когда они вызываются из другой процедуры VBA. Следовательно, они объяв;шются с ключевым словом P r i v a t e и не отображаются в диалоговом окне Excel Мастер функций.

Примеры, приведенные в этом разделе, можно найти на Web-узле издательства,

Функция FileExists

Данная функция получает один аргумент (путь и имя файла) и возвращает ИСТИНА, если файл существует.

Private Function FileExists(fname) As Boolean ' Возвращает ИСТИНА, если файл существует

FileExists = {Dir(fname) <> "") End Function

Функция FileNameOnly

Функция получает один аргумент (путь и имя файла) и возвращает только имя файла. Другими словами, функция обрезает путь.

Private Function FileNameOnly(pname) As String

1	Возвращает имя файла из пути/имени файла
294	Глава 11. Примеры и методы программирования на VBA

Dim i As Integer, length As Integer, temp As String length = Len(pname)

temp = ""

For i = length To 1 Step -1

If Mid{pname, i, 1) = Application.PathSeparator Then FileNameOnly = temp

Exit Function End If

temp = Midfpname, i, 1) & temp Next i

Fi1eNameOnly = pnarae End Function

Функция FileNameOnly выполняется для любого пути и имени файла (даже если файл не существует). Если файл существует, то следующая функция более просто удаляет путь и возвращает имя файла.

Private Function FileNameGnly2(pname) As String FileName0nly2 = Dir(pname)

End Function

Функция PathExists

Функцияполучаетодинаргумент(путь) и возвращаетИСТИНА, еслипутьсуществует. Private Function PathExists{pname) As Boolean

1Возвращает ИСТИНА, если путь существует Dim x As String

On Error Resume Next

x = GetAttr(pname) And 0

If Err = 0 Then PathExists = True _

Else PathExists = False

End Function

Функция RangeNameExists

Функция получает один аргумент (название диапазона) и возвращает ИСТИНА, если в активной рабочей книге существует указанное иазвание диапазона.

Private Function RangeNameExists(nname) As Boolean

1Возвращает ИСТИНА, если название диапазона существует Dim n As Name

RangeNameExists = False

For Each n In ActiveWorkbook.Names

If UCase(n.Name) = UCase(nname) Then RangeNameExists = True

Exit Function

End If

Next n

End Function

Функция SheetExists

Функция получает один аргумент (название рабочего листа) и возвращает ИСТИНА, если данный рабочий лист существует в активной рабочей книге.

Private Function SheetExists(sname) As Boolean

Возвращает ИСТИНА, если лист существует в активной рабочей книге

Часть ///. VisualBasic forApplications

295

Dim x As Object

On Error Resume Next

Set x a ActiveWorkbook.Sheets(sname)

If Err = 0 Then SheetExists = True _

Else SheetExists = False

End Function

Функция WorkbooklsOpen

Функция получает один аргумент (название рабочей книги) и возвращает ИСТИНА, если данная рабочая книга открыта.

Private Function WorkbooklsOpen(wbname) As Boolean Возвращает ИСТИНА, если рабочая книга открыта Dim х As Workbook

On Error Resume Next

Set x = Workbooks(wbname)

If Err = 0 Then WorkbooklsOpen = True _ Else WorkbooklsOpen = False

End Function

Проверка принадлежности кколлекции

Следующая функция представляет "групповую" функцию, которую можно использовать для определения, является ли объект членом колпекции.

Private Function IsInCollection(Coin As Object, _ Item As String) As Boolean

Dim Obj As Object On Error Resume Next Set Obj = Coin(Item)

IsInCollection = Not Obj Is Nothing End Function

Данная функция имеет два аргумента: коллекцию (объект) и элемент (строка), который может являться или не являться членом данной коллекции. Функция будет создавать переменную объекта, представляющую элемент в коллекции. Если попытка успешна, функция возвращает True; в противном случае функция возвращает False.

Вы можете использовать функцию IsInCollection вместо трех других функций, перечисленных В ЭТОЙ главе: RangeNameExists, SheetExists И WorkbooklsOpen. Чтобы определить, СОдержится ли в активной книге диапазон с названием Data, вызовите функцию IsInCollection с оператором

MsgBox IsInCollection{ActiveWorkbook.Names, "Data")

Для определения, открыта ли рабочая книга с названием Budget, используйте оператор MsgBox IsInCollection{Workbooks, "budget.xls"i

С целью определить, содержит ли активная рабочая книга лист с названием Лист1, используйте оператор

MsgBox IsInCollection(ActiveWorkbook.Worksheets, "Лист!")

Получение значения из закрытой рабочей книги

В VBA не существует метода получения значения из закрытого файла рабочей книги. Однако вы можете воспользоваться возможностью управления связанными файлами, предоставленной в Excel, В настоящем разделе огшсана функция VBA (GetValue, показанная ниже), которая получает значение из закрытой книги. Эта задача выполняется в результате вызова макроса XLM

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

Private Function GetValue(path, file, sheet, ref)

1	Получает	значение из закрытой рабочей книги
	Dim arg As		String
'	Проверка	существования файла
	If Right(path, 1) <> "\" Then path » path & " \"
	If Dir(path & file) = "" Then
	GetValue = "Файл не найден"
	Exit	Function
	End If
1	Создание	аргумента
	arg =	& path & "[" & file & " ] " & sheet & '"!" & _
	Range(ref).Range("Al").Address(, , xlRlCl)
1	Выполнение		макроса XLM
	GetValue	=	ExecuteExcel4Macro{arg)
End	Function

Функция GetValue имеет четыре аргумента;

p a t h — путь к закрытому файлу (например, "d: \f iles"); fil e — название рабочей книги (например, "budget .xls"); sheet — название рабочего листа (например, "Лист1");

ref — ссылка на ячейку (например, "С4").

Следующая процедура демонстрирует, как используется функция GetValue. В этой процедуре отображается значение ячейки А1 листа Лист1 файла 9 9Budget .xls (папка XLFiles\ Budget на диске С :}.

Sub TestGetValue{)

р = "C:\XLFiles\Budget" f = "99Budget.xls"

s = "Лист1" a = "Al"

MsgBox GetValue(p, £, s, a) End Sub

Ниже приведен еще один пример. Эта процедура считывает 1200 значений (100 строк и 12 столбцов) из закрытого файла и помещает эти значения на активный рабочий лист.

Sub TestGetValue2О
р =	"c:\XLFiles\Budget"
f =	"99Budget.xls"
Е = "Sheetl"
Application.ScreenUpdating		=	False
For r = 1 To 100
	For с = 1 To 12
	a = Cells(r, c}.Address
	Cellstr, c) = GetValue(p, f, s, a)
	Next с
Next	r
Application,ScreenUpdating		=	True
End Sub
	Функция Getvalue не работает, если ее использовать в формуле рабочего лис-
	та. Эту функцию вообще не рекомендуется использовать в формуле. Вы можете
	просто создатьформулусо ссылкойдля получениязначения из закрытого файпа.

ЧастьШ. VisualBasicforApplications

297

Полезные функции в формулах Excel

Примеры, приведенные в этом разделе, представляют пользовательские функции, которые можно использовать в формулах рабочего листа. Помните, что эти процедуры функций необходимо определить в модуле VBA (а не модуле кода соответствующей рабочей книги Эта книга (ThisWorkbook), листа или формы.).

Примеры из этого раздела можно найти на Web-узле издательства.

Получение информации о форматировании ячейки

Данный раздел содержит ряд пользовательских функций, возвращающих информацию 0 форматировании ячейки. Такие функции используются при сортировке данных на основе форматирования (например, в случае, когда ячейки, выделенные полужирным шрифтом, должны располагаться рядом).

Вы убедитесь, что эти специальные функции не всегда обновляются автоматически — изменение форматирования не запускает команду пересчета формул в Excel. Чтобы вызвать глобальный пересчет формул (и обновить все пользовательские функции), нажмите <Ctrl+Alt+F9>,

Следующая функция возвращает ИСТИНА, если аргумент, состоящий из одной ячейки, выделен полужирным шрифтом.

Function ISBOLD(cell) As Boolean

1 Возвращает ИСТИНА, если для ячейки задан полужирный шрифт ISBOLD = cell.Range("Al").Font.Bold

End Function

Следующая функция возвращает ИСТИНА, если ячейка (аргумент) выделена курсивом.

Function ISITALIC(cell) As Boolean

1 Возвращает ИСТИНА, если для ячейки задан курсив ISITALIC = cell.Range("Al").Font.Italic

End Function

Обе предыдущие функции возвращают ошибку, если ячейка имеет смешанное форматирование — например, полужирным шрифтом отображены только отдельные символы. Функция, приведенная ниже, возвращает ИСТИНА только тогда, когда все символы в ячейке выделены полужирным шрифтом.

Function ALLBOLD(cell) As Boolean

1 Возвращает ИСТИНА, если все символы в ячейке

'выделены полужирным шрифтом

If IsNull(cell.Font.Bold) Then

ALLBOLD = False

Else

ALLBOLD = cell.Font.Bold

End If

End Function

Функция FILLCOLOR, представленная далее, возвращает целое число, соответствующее индексу цвета фона ячейки (цвета заливки ячейки). Если ячейка не имеет заливки, то функция возвращает значение 4142.

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