VBA в Microsoft Access

Эти правила позволяют предложить ряд решений описанной проблемы. Предположим, переменная strLastName содержит строку "Smith" и вы хотите создать секцию WHERE для поиска по этому имени; получается следующая строка:

"[LastName] = "Smith""

Однако такое выражение запрещено, поскольку оно содержит внутренние кавычки. Следующая строка была бы допустима:

"[LastName] = ""Smith"""

Однако в данном случае литерал Smith находится внутри выражения. На первый взгляд кажется, что его следует заменить именем переменной strLastName:

"[LastName] = ""strLastName"""

Но в этом случае Access будет искать запись с фамилией strLastName (и вероятно, не найдет).

Таким образом, первое решение заключается в том, чтобы разбить выражение на три части - символы, предшествующие переменной, саму переменную и символы, следующие за переменной (то есть завершающую кавычку):

"[LastName] = """ & strLastName & """"

Хотя на первый взгляд изобилие кавычек выглядит странно, в действительности все верно. Первая часть выражения:

"[LastName] = """

Эта часть представляет собой строку, содержащую имя поля, знак равенства и две кавычки. В соответствии с приведенными выше правилами две кавычки в строке интерпретируются как одна. Аналогичная логика применима и к той части выражения, которая следует за переменной ("""") - это строка, содержащая два символа кавычки, которые Access воспринимает как одну кавычку. Хотя такое решение работает, оно выглядит довольно запутанно.

Для упрощения записи можно заключить внутреннюю строку в ' (апостроф)апострофы:

"[LastName] = '" & strLastName & "'"

Новый вариант выглядит проще, но у него есть серьезный недостаток: если фамилия содержит внутренние апострофы (например, «O’Connor»), возникнут серьезные неприятности. Такое решение подходит только в том случае, если содержимое переменной заведомо не содержит апострофов.

Внутренние кавычки проще всего создаются при помощи конструкции Chr$(34). Предыдущее выражение в этом случае выглядит так:

"[LastName] = " & Chr$(34) & strLastName & Chr$(34)

Если вы сомневаетесь в том, что такое решение будет нормально работать, вызовите окно отладки и введите команду:

? Chr$(34)

Access выводит значение Chr$(34) - символ ".

Чтобы немного упростить решение, можно объявить в начале процедуры строковую переменную и присвоить ей результат вызова Chr$(34):

Dim strQuote As String

Dim strLookup As String

strQuote = Chr$(34)

strLookup = "[LastName] = " & strQuote & strLastName & strQuote

Программа становится почти понятной!

Наконец, если вам надоест определять эту переменную во всех процедурах, воспользуйтесь глобальной константой. Сначала возникает искушение использовать запись вида:

Const QUOTE = Chr$(34)

К сожалению, Access не позволяет определять константы, значение которых задается выражением с вызовами функций. Если вы захотите использовать такую константу, положитесь на синтаксис «удвоенных кавычек»:

Const QUOTE = """"

Возможно, в этом выражении разобраться с первого взгляда нелегко, но оно нормально работает. Константа состоит из двух кавычек (которые воспринимаются Access как одна), заключенных в кавычки. При наличии такой константы приведенное выше выражение принимает вид:

strLookup = "[LastName] = " & QUOTE & strLastName & QUOTE

Все перечисленные правила реализуются функцией acbFixUp из модуля basFixUpValue базы данных 07-01.MDB. Функция получает параметр типа Variant и заключает его в соответствующие ограничители. Код функции acbFixUp выглядит так:

Function acbFixUp(ByVal varValue As Variant) As Variant

    ' Добавление ограничителей в зависимости от типа данных параметра.

    ' Текст заключается в кавычки, даты - между символами "#",

    ' числа не требуют разделителей.

    '

    ' Если в выражении присутствует проверка равенства,

    ' вместо вызова этой функции следует использовать

    ' функцию Basic BuildCriteria.

    Const QUOTE = """"

    Select Case VarType(varValue)

        Case vbInteger, vbSingle, vbDouble, vbLong, vbCurrency

            acbFixUp = CStr(varValue)

        Case vbString

            acbFixUp = QUOTE & varValue & QUOTE

        Case vbDate

            acbFixUp = "#" & varValue & "#"

        Case Else

            acbFixUp = Null

    End Select

End Function

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

"[LastName] = " & FixUp(strLastName)

Функция acbFixUp сама определяет тип данных и заключает их в соответствующие ограничители.

ПРИМЕЧАНИЕ

В Access также имеется полезная функция BuildCriteria, функцияBuildCriteria, которой при вызове передается имя поля, тип данных и значение поля. Функция с применением ограничителей в зависимости от типа данных создает выражение вида

имя_поля = "значение"

В нашем примере эта функция применяется при снятом флажке Use Like. Наличие поисковых метасимволов не позволяет использовать функцию BuildCriteria, но при поиске точного совпадения она упрощает вставку правильных ограничителей. За практическим примером обращайтесь к функции BuildWhere модуля frmQuoteTest.

Создание глобального стека процедур

Проблема

В приложениях довольно часто требуется узнать имя текущей процедуры внутри программы. Например, ошибки могут обрабатываться обобщенной функцией, которая выводит имя процедуры с ошибкой (а также всех процедур, вызванных перед ней). VBA не содержит средств для получения этой информации. Как узнать имя текущей процедуры?

Решение

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

Структура данных, используемая для ведения списка, называется стек стеком . При входе в новую процедуру ее имя заносится в стек, а при выходе из процедуры оно извлекается («выталкивается») из стека. На рис. 7.2 представлена диаграмма работы стека. Стрелки означают направления, в которых изменяется размер стека при добавлении и удалении элементов.

Чтобы увидеть, как работает стек процедур, загрузите базу данных 07-02.MDB. Откройте модуль basTestStack в режиме конструктора и вызовите окно отладки, выбрав команду View4Immediate Window. Введите команду

? A()

Рис. 7.2. Стек вызовов и процедуры его заполнения

Команда выполняет функцию с именем A. На рис. 7.2 представлена функция A и вызываемые ею процедуры. На каждом шаге текущая процедура заносит свое имя в стек процедур и вызывает процедуру следующего уровня, а при возврате управления она выталкивает свое имя из стека. Кроме того, каждая процедура выводит в окне отладки имя текущей процедуры (при помощи функции acbCurrentProc, описанной ниже). Примерный вид окна отладки после выполнения функции A показан на рис. 7.3.

Рис. 7.3. Результат выполнения функции A

Чтобы реализовать аналогичную возможность в своем приложении, выполните следующие действия.

1.Импортируйте модуль basStack в свое приложение. В модуле содержатся процедуры, обеспечивающие инициализацию и ведение стека процедур.

2.Включите вызов процедуры acbInitStack в код, выполняемый в начале работы приложения, - например, в процедуру обработки события Load главной формы приложения. Процедура acbInitStack должна вызываться при каждом перезапуске программы в процессе разработки, поэтому ее, вероятно, не следует включать в макрос Autoexec, выполняемый только при первой загрузке базы данных. Вызов процедуры acbInitStack осуществляется либо простым указанием ее имени acbInitStack, либо конструкцией с ключевым словом CallCall:

    Call acbInitStack

3.Каждая функция или процедура приложения должна начинаться с вызова процедуры acbPushStack, которая сохраняет полученный параметр в стеке. При каждом вызове acbPushStack передается один аргумент - имя текущей процедуры. В нашем примере за именами функций следуют круглые скобки, а имена процедур передаются без скобок; впрочем, на работу программы это не влияет. Все процедуры должны завершаться вызовом процедуры acbPopStack, извлекающей имя текущей процедуры из стека.

4.Чтобы узнать имя текущей процедуры в любой точке программы, вызовите функцию acbCurrentProc. Функция анализирует верхний элемент стека и возвращает найденную строку. Полученная информация может использоваться для обработки ошибок или для хронометража, как показано в следующем разделе.

Комментарий

Модуль basStack, импортированный из базы данных 07-02.MDB, содержит определение локальной переменной стека процедур, а также код выполнения стековых операций. Модуль имеет шесть точек входа, то есть процедур, вызываемых извне. Эти процедуры перечислены в табл. 7.1. Поскольку весь код стека инкапсулирован в одном модуле, вам даже не обязательно знать, как он работает, но в действительности все просто.

Таблица 7.1. Шесть точек входа модуля basStack

В модуле basStack определяются две переменные уровня модуля. Массив строк mastrStack представляет собой непосредственную реализацию стека, а целочисленная переменная mintStackTop содержит индекс массива, с которым следующий элемент будет занесен в стек. В начале работы со стеком переменная mintStackTop равна 0, поэтому первый элемент сохраняется в позиции с номером 0. Инициализация стека в процедуре acbInitStack ограничивается простым обнулением переменной mintStackTop:

Public Sub acbInitStack()

    ' Обнуление указателя на вершину стека.

    mintStackTop = 0

End Sub

Процедура acbPushStack заносит в стек новый элемент. При вызове ей передается строковое значение, сохраняемое в стеке. Параметр сохраняется в элементе массива с индексом mintStackTop, после чего значение индексной переменной увеличивается. Код процедуры acbPushStack приведен ниже.

Public Sub acbPushStack(strToPush As String)

    ' Занесение строки в стек.

    ' В случае переполнения стека выводится сообщение об ошибке.

    ' При наличии свободного места элемент сохраняется в стеке.

    ' Сначала обрабатывается возможная ошибка переполнения.

    If mintStackTop > acbcMaxStack Then

        MsgBox acbcMsgStackOverflow

    Else

        ' Сохранение строки.

        mastrStack(mintStackTop) = strToPush

        ' Переменная mintStackTop определяет индекс

        ' СЛЕДУЮЩЕГО элемента, заносимого в стек.

        mintStackTop = mintStackTop + 1

    End If

End Sub

Единственная потенциальная проблема связана с переполнением стека. Максимальная глубина стека (константа acbcMaxStack) в нашем приложении равна 20, а этого должно быть вполне достаточно - ведь переменная mintStackTop увеличивается только при переходе на следующий уровень, то есть при вызове процедуры из другой процедуры. Если в вашем приложении глубина вызова процедур превышает 20 уровней, лучше подумать об изменении структуры приложения, чем об увеличении стека! В случае переполнения процедура acbPushStack выводит предупреждающее сообщение и не сохраняет элемент в стеке.

При выходе из процедуры верхний элемент удаляется из стека. Задача решается вызовом процедуры acbPopStack:

Public Sub acbPopStack()

    ' Извлечение строки из стека.

    ' Если стек пуст, выводится сообщение об ошибке.

    ' В противном случае указатель на вершину стека

    ' смещается к предыдущему элементу. При необходимости

    ' информация регистрируется в журнале.

    ' Сначала обрабатывается возможная ошибка.

    If mintStackTop = 0 Then

        MsgBox acbcMsgStackUnderflow

    Else

        ' Поскольку элемент удаляется, а не заносится в стек,

        ' указатель на вершину стека перемещается к предыдущему элементу.

        ' Следующий элемент, заносимый в стек, будет сохранен

        ' на месте удаленного элемента.

        mintStackTop = mintStackTop - 1

    End If

End Sub

Как и в процедуре acbPushStack, мы сначала проверяем потенциальную ошибку - попытку удаления элемента из пустого стека. В этом случае acbPopStack выводит предупреждающее сообщение и завершает работу. Если стек содержит элементы, процедура уменьшает переменную mintStackTop, в результате чего следующий вызов acbPushStack сохранит новый элемент на месте старого.

Функция acbGetCurrentProc читает значение элемента, находящегося на вершине стека, без сохранения или удаления элементов:

Public Function acbCurrentProc() As String

    ' Поскольку mintStackTop всегда указывает на позицию

    ' следующего элемента, заносимого в стек,

    ' функция должна вернуть значение элемента

    ' в позиции minStackTop - 1.

    If mintStackTop > 0 Then

       acbCurrentProc = mastrStack(mintStackTop - 1)

    Else

        acbCurrentProc = ""

    End If

End Function

Функция читает последний элемент, занесенный в стек (его индекс равен mintStackTop-1, поскольку mintStackTop всегда определяет индекс следующего сохраняемого элемента). Просто просмотреть содержимое mastrStack (без вызова интерфейсной функции) невозможно, поскольку данные стека являются локальными для модуля basStack - именно так и должно быть. Подробности реализации стека скрыты от внешних пользователей, поэтому вы можете внести изменения в basStack, выбрать другую структуру данных для хранения стека и т. д.; остальной код приложения будет работать с новой версией стека так же, как со старой.

Дополнительная информация о стеке возвращается функциями acbGetStackItems (количество элементов в стеке) и acbGetStack (чтение элемента стека, находящегося в заданной позиции). Например, следующий фрагмент выводит все содержимое стека (именно это делается в процедуре D модуля basTestStack):

Debug.Print "Stack items currently:"

For intI = 0 To acbGetStackItems() - 1

    Debug.Print , acbGetStack(intI)

Next intI

Функция acbGetStackItems устроена очень просто: она возвращает значение mintStackTop, поскольку эта переменная всегда совпадает с количеством элементов в стеке.

Public Function acbGetStackItems() As Integer

    ' Функция возвращает количество элементов в стеке.

    acbGetStackItems = mintStackTop

End Function

Функция acbGetStack устроена несколько сложнее. Она получает номер элемента от вершины стека (0 соответствует верхнему элементу) и вычисляет позицию возвращаемого элемента. Код функции acbGetStack выглядит так:

Public Function acbGetStack(mintItem As Integer) As String

    ' Функция возвращает элемент, находящийся на расстоянии mintItems

    ' от вершины стека. Таким образом, acbGetStack(0)

    ' совпадает с результатом вызова acbCurrentProc,

    ' а acbGetStack(3) возвращает четвертый элемент от вершины стека.

    If mintStackTop >= mintItem Then

        acbGetStack = mastrStack(mintStackTop - mintItem - 1)

    Else

        acbGetStack = ""

    End If

End Function

Для нормальной работы стека процедур при входе и выходе из каждой процедуры необходимо вызывать процедуры acbPushStack и acbPopStack. Считается, что при хорошем стиле программирования в каждой процедуре должна существовать только одна точка выхода, но даже лучшие программисты иногда нарушают это правило. При использовании стека вызовов каждой точке выхода должен соответствовать свой вызов acbPopStack. Помните об этом, когда будете адаптировать старый код или разрабатывать новый код для работы со стеком процедур. Впрочем, процедуру всегда можно запрограммировать с одной точкой выхода, что существенно упростит сопровождение программы.

Хронометраж вызовов функций

Проблема

Вы хотите оптимизировать свой код VBA, но на практике почти невозможно определить, сколько времени тратится на выполнение той или иной функции и какие процедуры чаще всего вызываются в программе. Требуется узнать, какие процедуры вызываются программой, в какой последовательности и сколько времени тратится на выполнение каждой из них. Как это сделать?

Решение

Используя методику, описанную в разделе «Создание глобального стека процедур», можно создать программу ведения журнала на базе стека и отслеживать последовательность и затраты времени на выполнение процедур приложения. Хотя программа получается более сложной, чем описанная в предыдущем разделе, написать ее не так уж сложно, а использовать еще проще, поскольку вся работа выполняется в одном модуле.

Откройте базу данных 07-03.MDB и загрузите модуль basTestProfiler в режиме конструктора. Введите в окне отладкаотладки команду

? A()

Команда запускает тестовую функцию. На рис. 7.4 представлен стек вызовов и код функции A. Как видно из рисунка, A вызывает процедуру B, которая вызывает C, которая в свою очередь вызывает D; эта процедура делает паузу в 100 мс и затем возвращает управление C. Процедура C тоже делает паузу в 100 мс и снова вызывает D. После выхода из D процедура C возвращает управление B; эта процедура тоже выжидает 100 мс и снова вызывает C. Все это повторяется до тех пор, пока управление не будет возвращено функции A для окончательного завершения. Результаты хронометража, показанные на рис. 7.4, были получены в результате тестового запуска.

Рис. 7.4. Стек вызовов и процедуры, используемые для его заполнения

Программа записывает результаты своей работы в файл LOGFILE.TXTLOGFILE.TXT, находящийся в установочном каталоге Access. Содержимое этого файла можно просмотреть в любом текстовом редакторе. При тестовом запуске A файл содержал следующий текст:

********************************

Procedure Profiling

8/13/2003 3:29:11 PM

********************************

+ Entering procedure: A()

    + Entering procedure: B

        + Entering procedure: C

            + Entering procedure: D

            - Exiting procedure : D                 101 msecs.

            + Entering procedure: D

            - Exiting procedure : D                 100 msecs.

        - Exiting procedure : C                     301 msecs.

        + Entering procedure: C

            + Entering procedure: D

            - Exiting procedure : D                 100 msecs.

            + Entering procedure: D

            - Exiting procedure : D                 100 msecs.

        - Exiting procedure : C                     300 msecs.

    - Exiting procedure : B                         701 msecs.

    + Entering procedure: B

        + Entering procedure: C

            + Entering procedure: D

            - Exiting procedure : D                 100 msecs.

            + Entering procedure: D

            - Exiting procedure : D                 100 msecs.

        - Exiting procedure : C                     300 msecs.

        + Entering procedure: C

            + Entering procedure: D

            - Exiting procedure : D                 100 msecs.

            + Entering procedure: D

            - Exiting procedure : D                 101 msecs.

        - Exiting procedure : C                     301 msecs.

    - Exiting procedure : B                         701 msecs.

- Exiting procedure : A()                          1513 msecs.

Чтобы организовать подобный хронометраж в своем приложении, выполните следующие действия.

1.Импортируйте модуль basProfiler в свое приложение. В модуле содержатся процедуры, обеспечивающие инициализацию и ведение стека процедур.

2.Включите вызов процедуры acbProInitCallStack в код, выполняемый при запуске приложения. Но если в решении из раздела «Создание глобального стека процедур» можно было обойтись без вызова процедуры инициализации, на этот раз acbProInitCallStack вызывается каждый раз, когда требуется провести хронометраж, или стек будет работать неверно. При вызове в процедуру acbProInitCallStack передаются три параметра, относящиеся к логическому типу (True или False). Описания этих параметров приведены в табл. 7.2.

Таблица 7.2. Параметры процедуры acbProInitCallStack

3.Процедура инициализирует несколько глобальных переменных и, если должен вестись журнал вызовов, записывает в файл заголовок журнала. Типичный вызов acbProInitCallStack выглядит так:

acbProInitCallStack False, True, True

4.Каждая функция или процедура приложения должна начинаться с вызова процедуры acbProPushStack, которая сохраняет в стеке полученный параметр и текущее время. При каждом вызове acbProPushStack передается один аргумент - имя текущей процедуры. В нашем примере за именами функций следуют круглые скобки, а имена процедур указываются без скобок; впрочем, на работу программы это не влияет. Все процедуры должны завершаться вызовом процедуры acbProPopStack, которая извлекает имя процедуры из стека и регистрирует текущее время.

5.Чтобы узнать имя текущей процедуры в любой точке программы, вызовите функцию acbProCurrentProc. Функция анализирует верхний элемент стека и возвращает найденную строку.

6.Результаты хронометража записываются в файл LOGFILE.TXT (в каталоге базы данных Access), и их можно просмотреть в любом текстовом редакторе. Если вы внимательно выполнили все приведенные инструкции, для каждой функции или процедуры в файле будут присутствовать записи входа и выхода. Вложенные уровни выделяются отступом, а точки входа и выхода помечаются разными знаками (точка входа - знаком +, а точка выхода - знаком -).

Комментарий

Модуль basProfiler, импортированный из базы данных 07-03.MDB, содержит весь код хронометража. Он содержит пять точек входа, перечисленных в табл. 7.3.

Таблица 7.3. Пять точек входа модуля basProfiler

В целом хронометраж работает практически так же, как операции с простым стеком процедур из раздела «Создание глобального стека процедур». Кстати, авторы сначала разработали это решение, а затем сократили его до более простого примера. В этот пример входит код записи файла на диск, а также код сбора хронометражных данных. Основные различия описаны ниже.

Если в решении из раздела «Создание глобального стека процедур» данные стека хранились в простом массиве строк, для хронометража также необходимо хранить время запуска и завершения каждой процедуры. Стек реализуется в виде массива структур acbStack, определяемых следующим образом:

Type acbStack

    strItem As String

    lngStart As Long

    lngEnd As Long

End Type

Dim maStack(0 To acbcMaxStack) As acbStack

В Access существует функция Timer, которая возвращает количество секунд, прошедших с полуночи, но ее разрешающей способности недостаточно для хронометража процедур в Access Basic. Вместо нее лучше использовать функцию Windows TimeGetTime, функцияTimeGetTime, которая возвращает количество миллисекунд, прошедших с момента запуска Windows. Функция TimeGetTime обнуляет возвращаемое значение через 48 дней, тогда как функция Timer сбрасывается ежедневно - если вам понадобится выполнить продолжительную операцию, timeGetTime позволит измерить промежуток времени продолжительностью более одного дня (а также работать с интервалами, переходящими за полночь). Конечно, если операция выполняется больше суток, миллисекундная точность вряд ли существенна, но это другой вопрос. Код basProfiler вызывает timeGetTime для получения текущего «времени» при каждом занесении или удалении элемента из стека. После включения следующего объявления в глобальный модуль вы можете свободно вызывать timeGetTime в своем приложении:

Public Declare Function timeGetTime _

  Lib "winmm.dll" Alias "timeGetTime" () As Long

В модуле basTestProfiler функция TimeGetTime также используется в процедуре Wait. Эта процедура организует задержку заданной продолжительности (в миллисекундах), при этом внутри цикла выполняется команда DoEvents, чтобы система Windows могла выполнить свою работу:

Public Sub Wait(intWait As Integer)

    Dim lngStart As Long

    lngStart = acb_apiTimeGetTime()

    Do While acb_apiTimeGetTime() < lngStart + intWait

        DoEvents

    Loop

End Sub

Код basProfiler открывает и закрывает выходной файл при каждой записи. Это замедляет работу приложения, но зато гарантирует, что при возникновении сбоев по какой-либо причине файл журнала всегда будет содержать самую свежую информацию. Если вы никогда не использовали Access для прямой записи текстовых файлов, посмотрите, как это делается.

Процедура acbProWriteToLog сначала проверяет, происходили ли ошибки при записи в журнал (то есть установлен ли флаг mfLogErrorOccurred). При наличии ошибок процедура ничего не пытается записывать в файл, потому что ошибки могут быть связаны со сбоями на диске. Если все было нормально, процедура получает свободный файловый идентификатор, открывает файл журнала для присоединения данных, записывает информацию и закрывает файл. Ниже приведен код процедуры acbProWriteToLog:

Private Sub acbProWriteToLog(strItem As String)

    Dim intFile As Integer

    On Error GoTo HandleErr

    ' Если в текущем сеансе произошла ХОТЬ ОДНА ошибка,

    ' выйти из процедуры.

    If mfLogErrorOccurred Then Exit Sub

    intFile = FreeFile

    Open acbcLogFile For Append As intFile

    Print #intFile, strItem

    Close #intFile

ExitHere:

    Exit Sub

HandleErr:

    mfLogErrorOccurred = True

    MsgBox Err & ": " & Err.Description, , _

      "Writing to Log"

    Resume ExitHere

End Sub

Как и в разделе «Создание глобального стека процедур», стековый механизм профилированиеведения журнала приносит пользу лишь в том случае, если при входе и выходе из каждой процедуры выполняются вызовы acbProPushStack и acbProPopStack. Если процедура содержит несколько точек выхода, подумайте, нельзя ли их объединить. Если это невозможно, проследите за тем, чтобы перед каждой точкой выхода из процедуры выполнялся вызов acbProPopStack.

В процессе анализа журнала становится понятно, что в затратах времени на выполнение каждой процедуры должно учитываться время работы всех процедур, вызываемых из нее. Например, в нашем примере функция A вызывает процедуру B, из которой вызываются процедуры C и D. Время выполнения A составило 1513 мс, но эта величина соответствует интервалу между вызовами acbProPushStack и acbProPopStack в функции A, и в нее входит время выполнения процедур B, C и D. Не стоит воспринимать это как серьезную проблему, но следует помнить, что использованный механизм не позволяет «останавливать часы» при вложенных вызовах процедур.

В модуле basProfiler предусмотрена еще одна открытая точка входа, acbProLogString. В приведенной программе она не вызывается, но вы можете использовать ее в своих программах. Процедура получает строку и сохраняет ее в файле журнала. Например, следующая команда записывает в журнал строку «This is a test»:

acbProLogString "This is a test"

Многозадачность в коде Access Basic

Проблема

Если в программе VBA используется цикл, который выполняется дольше одной-двух секунд, Access словно «замирает». Невозможно перемещать окна на экране, а щелчки мышью в Access игнорируются до тех пор, пока программа не выйдет из цикла. Почему это происходит? И что можно сделать, чтобы система могла работать?

Решение

Вероятно, вы уже замечали, что простой фрагмент кода VBA способен парализовать работу Access. Поддержка многозадачностьмногозадачности в 32-разрядных версиях Windows помогает лишь в том случае, если она поддерживается в приложениях. Оказывается, выполнение кода Basic не позволяет выполняться коду Access, поэтому многозадачная природа Windows здесь не поможет. Если ваша программа содержит очень долгие циклы, вы должны специально позаботиться о том, чтобы на время уступать управление Windows и позволять системе выполнять свою работу. В VBA эта задача решается при помощи команды DoEvents. При правильном использовании команды DoEvents приложение-«монополист», подавляющее многозадачные возможности Access, превращается в нормальное приложение, которое позволяет Access нормально работать во время выполнения кода VBA.

Откройте базу данных 07-04.MDB и запустите форму frmDoEvents (рис. 7.5). На форме находятся три кнопки, каждая из которых изменяет ширину надписи «Watch Me Grow!» от 500 до 3500 твипов с единичным приращением (на рисунке видна лишь часть надписи). Ширина надписи изменяется в следующем цикле:

Me.lblGrow1 = 500

For intI = 0 To 3000

    Me.lblGrow1.Width = Me.lblGrow1.Width + 1

    ' Без вызова Repaint экран не обновляется

    Me.Repaint

Next intI

Рис. 7.5. Тестовая форма frmDoEvents во время выполнения

Чтобы на практике познакомиться с последствиями команды DoEvents, выполните упражнение.

1.Щелкните на кнопке Run Code Without DoEvents. Процедура, связанная с этой кнопкой, изменяет ширину надписи в цикле без передачи управления Access. Попробуйте щелкнуть на другой кнопке формы, переместить или изменить размеры активного окна во время выполнения цикла. Вы увидите, что в процессе увеличения надписи ни одна из этих операций не выполняется. После того как надпись перестает расти, Access обрабатывает все действия, которые вы пытались выполнить во время цикла.

2.Попробуем выполнить аналогичный цикл с командой DoEvents. Щелкните на второй кнопке, Run Code With DoEvents1. На этот раз во время выполнения программы можно перемещать активное окно или изменять его размеры, а также щелкать на кнопках формы. Данная возможность будет протестирована на следующем шаге.

3.Во время увеличения надписи несколько раз быстро щелкните на кнопке Run Code With DoEvents1. При каждом щелчке Access запускает новый экземпляр процедуры обработки события Click, событиеClick, и каждый экземпляр продолжает независимо увеличивать надпись. Перед нами пример рекурсии , то есть нескольких вызовов процедуры, стартующих до завершения предыдущего вызова. При каждом вызове события Click используется небольшая часть стековой памяти Access (области памяти, предназначенной для хранения параметров и переменные;локальныелокальные переменныелокальных переменных процедур). Теоретически при очень большом количестве вызовов эта память может быть израсходована. Начиная с Access 95 и далее, эта проблема практически никогда не возникает, но в Access 2 переполнение стека было вполне обычным явлением. На следующем шаге продемонстрировано решение этой проблемы.

4.Щелкните на третьей кнопке, Run Code with DoEvents2. Пока надпись продолжает увеличиваться, снова щелкните на кнопке. На этот раз щелчки не имеют никакого эффекта. Процедура обработки события Click проверяет, выполняется ли она в настоящий момент, и если выполняется - отменяет запуск своего нового экземпляра. Подобная проверка решает проблему рекурсиярекурсивных вызовов DoEvents, командаDoEvents.

Комментарий

Процедура, связанная с первой кнопкой, совершенно не заботится об интересах Windows и других приложений. При щелчке на кнопке выполняется следующий код:

Private Sub cmdNoDoevents_Click()

    Dim intI As Integer

    Me.lblGrow1.Width = 500

    For intI = 0 To 3000

        Me.lblGrow1.Width = Me.lblGrow1.Width + 1

        ' Без вызова Repaint экран не обновляется.

        Me.Repaint

    Next intI

End Sub

Поскольку процедура не позволяет Windows выполнить «свою работу», в нее необходимо включить вызов метода Me.Repaint, обеспечивающий перерисовку формы после каждого изменения. Чтобы понять смысл этой строки, закомментируйте ее и снова щелкните на первой кнопке - вы увидите, что форма перерисовывается лишь после завершения всей операции.

Процедура второй кнопки работает аналогично, но у нее в цикл включена команда DoEvents. Вызов Me.Repaint становится необязательным, поскольку передача управления по команде DoEvents позволяет Windows обработать запросы на перерисовку, находящиеся в очереди. Во время выполнения этого цикла перемещается указатель мыши, а также работают другие приложения. Процедура обработки события Click для второй кнопки выглядит так:

Private Sub TestDoEvents()

    Dim intI As Integer

    Me.lblGrow1.Width = 500

    For intI = 0 To 3000

        Me.lblGrow1.Width = Me.lblGrow1.Width + 1

        DoEvents

    Next intI

End Sub

Private Sub cmdDoEvents1_Click()

    TestDoEvents

End Sub

Как упоминалось на шаге 2, недостаток этого кода заключается в том, что ничто не мешает пользователю в процессе выполнения запустить его заново; если щелкнуть на той же кнопке во время работы цикла, процедура запускается снова. В начале выполнения любой процедуры VBA Access всегда сохраняет информацию о процедуре и ее локальных переменных в специальной области памяти, называемой стеком. Стек имеет фиксированные размеры, что ограничивает количество одновременно выполняемых процедур. Если быстро щелкать на этой кнопке много раз подряд, можно вызвать переполнение стека Access.

Вряд ли вам удастся воспроизвести эту проблему с помощью нашей небольшой программы, поскольку размер стека, который в Access 2 составлял всего 40 Кбайт, в Access 95 был увеличен до 1 Мбайт. Чтобы переполнить такой блок памяти, придется очень быстро щелкать на кнопке в течение очень долгого времени. Впрочем, в более сложной ситуации и при передаче больших объемов данных в параметрах процедур такая проблема все же может возникнуть.

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

Private Sub cmdDoEvents2_Click()

    Static blnInHere As Boolean

    If blnInHere Then Exit Sub

    blnInHere = True

    TestDoEvents

    blnInHere = False

End Sub

Статическая переменная blnInHere является флагом предварительного запуска процедуры. Если переменная blnInHere равна True, значит, процедура работает в настоящий момент, поэтому мы просто возвращаем управление. Если переменная blnInHere равна False, процедура присваивает флагу True и затем вызывает процедуру TestDoEvents. После выхода из TestDoEvents1 процедура cmdDoEvents2_ Click снова сбрасывает флаг blnInHere, разрешая дальнейшие вызовы.

Многие программисты недостаточно хорошо понимают смысл команды DoEvents. Что бы эта команда ни должна была делать с точки зрения программиста, в Access 95 и более поздних версиях она всего лишь на время передает управление Access, позволяя обработать все сообщения, находящиеся в очереди. Команда никак не влияет на работу ядра Access, не может использоваться для искусственного замедления или синхронизации программы (если она не основана на обработке сообщений Windows). В коде VBA команда DoEvents передает управление операционной системе и получает его обратно лишь после того, как будут обработаны все необработанные события, а также клавиши в очереди SendKeys, очередьSendKeys. Access игнорирует вызовы DoEvents:

Как показывает вторая кнопка на форме, рекурсивный вызов процедуры с командой DoEvents может причинить неприятности. Проследите за тем, чтобы это не происходило в вашем приложении (как в случае с третьей кнопкой).

Программное добавление строк в список или поле со списком

Проблема

Задача заполнения списка или поля со списком из источника данных в Access решается элементарно. Тем не менее в некоторых ситуациях в списки приходится заносить данные, которые не хранятся в таблице. В Visual Basic и других средах VBA,  включая Access 2002 и выше, это делается просто: достаточно воспользоваться методом списки;добавление строкAddItem, методAddItem, но в предшествующих версиях Access списки не поддерживают этот метод. Как включить в список строку, не хранящуюся в таблице?

Решение

Действительно, до появления Access 2002 списки (а также поля со списками) не поддерживали метода AddItem, привычного для программистов Visual Basic. Чтобы упростить заполнение списков и полей со списками присоединенными данными, разработчикам Access пришлось отказаться от упрощенного метода занесения свободных данных в списки. Существует два способа, позволяющих обойти это ограничение при заполнении списков и полей со списками Access: самостоятельное построение свойства RowSource в приложении и определение функции функция обратного вызоваобратного вызова. Первый вариант просто реализуется, но работает только в элементарных ситуациях. С другой стороны, функция обратного вызова подходит для любых ситуаций, хотя и реализуется не столь тривиально. В приведенном решении продемонстрированы оба способа.

Конечно, возникает важный вопрос - зачем прибегать к этим искусственным средствам при заполнении списков и полей со списками? Если данные всегда можно перенести в элемент из таблицы, запроса или выражения SQL, зачем создавать себе трудности? Ответ прост: в некоторых случаях заранее неизвестно, с какими данными вам предстоит работать, причем эти данные не хранятся в таблицах. Возможны и другие варианты, например, при заполнении элемента содержимым массива, если вы не хотите сохранять данные в промежуточной таблице. До появления Access 2002 программисты были вынуждены либо создавать функцию обратного вызова для заполнения списка, либо самостоятельно изменять свойство элемента RowSource. Начиная с Access 2002, многие задачи по заполнению списков решаются методом AddItem.

Ниже описаны все три способа модификации содержимого списка или поля со списком во время работы приложения. Первый способ основан на модификации значения свойства RowSource при условии, что свойству Тип источника строк (RowSourceType) задается значение Список значений (Value List). Во втором способе список заполняется функцией обратного вызова. Наконец, последний способ основан на использовании метода AddItem.

Заполнение списка методом AddItem

1.Откройте базу данных 07-05.MDB и запустите форму frmAddItem.

2.Измените содержимое списка, установив переключатель Days или Months в группе слева. Опробуйте оба варианта и измените количество столбцов в списке. На рис. 7.6 представлена форма с выводом названий месяцев в три столбца.

Заполнение списка с модификацией свойства RowSource

1.Откройте базу данных 07-05.MDB и запустите форму frmRowSource.

2.Измените содержимое списка, установив переключатель Days или Months в группе слева. Опробуйте оба варианта и измените количество столбцов в списке. На рис. 7.6 представлена форма с выводом названий месяцев в три столбца.

Рис. 7.6. Форма frmRowSource с выводом названий месяцев в три столбца

Заполнение списка функцией обратного вызова

1.Откройте базу данных 07-05.MDB и запустите форму frmListFill.

2.Выберите в первом списке день недели. Во втором списке выводятся числа, на которые приходится заданный день (ближайшее и три следующих), как показано на рис. 7.7.

3.Свойство Тип источника строк (RowSourceType) соответствующего элемента должно содержать имя функции (без знака равенства и без круглых скобок). Функции, вызываемые таким образом, должны подчиняться жестким требованиям, описанным в следующем разделе. На рис. 7.8 представлено окно свойств для списка frmListFill, у которого в свойстве Тип источника строк (RowSourceType) указано имя функции обратного вызова.

Рис. 7.7. Списки формы frmListFill заполняются функциями обратного вызова

Рис. 7.8. Окно свойств для функции заполнения списка

Комментарий

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

Вызов метода AddItem

Начиная с Access 2002, для добавления новых элементов в список можно использовать метод AddItem элемента (а удаление элементов осуществляется парным методом RemoveItem, которому при вызове передается номер или текст элемента). Этот способ гораздо проще всех остальных, поэтому в первую очередь следует отдавать предпочтение именно ему.

При установке переключателя в группе Fill Choice выполняется следующий обработчик:

Private Sub grpChoice_AfterUpdate()

    Dim strList As String

    Dim intI As Integer

    Dim varStart As Variant

    lstAddItem.RowSourceType = "Value List"

    ' Очистка списка

    lstAddItem.RowSource = vbNullString

    lstAddItem.ColumnCount = 1

    grpColumns = 1

    Select Case Me.grpChoice

        Case 1   ' Дни

            ' Вычислить дату последнего воскресенья

            varStart = Now - WeekDay()

            ' Перебор всех дней недели

            For intI = 1 To 7

                lstAddItem.AddItem Format(varStart + intI, "dddd")

            Next intI

        Case 2   ' Месяцы

            For intI = 1 To 12

                lstAddItem.AddItem Format(DateSerial(2004, intI, 1), "mmmm")

            Next intI

    End Select

    Me.txtFillString = lstAddItem.RowSource

End Sub

В начале процедуры свойству RowSourceType задается текст "Value List":

lstAddItem.RowSourceType = "Value List"

Это очень важный момент: если свойство RowSourceType задано неверно (в режиме конструктора или в программе), вызвать методы AddItem и RemoveItem не удастся.

Далее программа очищает формат списка:

lstAddItem.RowSource = vbNullString

lstAddItem.ColumnCount = 1

grpColumns = 1

Затем в зависимости от выбранного переключателя программа заполняет список ListBox названиями дней недели или месяцев:

    Select Case Me.grpChoice

        Case 1   ' Дни

            ' Вычислить дату последнего воскресенья

            varStart = Now - WeekDay()

            ' Перебор всех дней недели

            For intI = 1 To 7

                lstAddItem.AddItem Format(varStart + intI, "dddd")

            Next intI

        Case 2   ' Месяцы

            For intI = 1 To 12

                lstAddItem.AddItem Format(DateSerial(2004, intI, 1), "mmmm")

            Next intI

    End Select

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

Me.txtFillString = lstAddItem.RowSource

ВНИМАНИЕ

Хотя на первый взгляд кажется, что в список действительно добавляются новые элементы, на самом деле программа просто изменяет значение свойства RowSource элемента. Следовательно, в этом варианте действуют те же ограничения, что и при ручном задании свойства (см. следующий раздел). В частности, размер свойства RowSource не может превышать максимального значения, которое в Access 2002 было равно 2048 символам (но может быть увеличено в будущих версиях).

Модификация свойства RowSource

Если вы работаете в Access 2002 и более поздних версиях, скорее всего, вам не придется использовать эту методику. С другой стороны, в более ранних версиях Access она позволяет легко заполнять несвязанные списки. Задавая свойству Тип источника строк (RowSourceType) значение Список значений (Value List), можно передать перечень строк, разделенных символом точки с запятой (;), которые будут использоваться для заполнения списка. Включая этот перечень в свойство Источник строк (RowSource), вы приказываете Access последовательно выводить элементы списка во всех заполняемых строках и столбцах списка. Поскольку данные вводятся непосредственно в окне свойств, их максимальный объем ограничивается максимальной длиной свойства, вводимого в окне свойств (его конкретное значение зависит от версии Access).

Свойство RowSource можно в любой момент модифицировать, задав в нем новый список элементов, разделенных символом точки с запятой. При этом следует учитывать свойство Число столбцов (ColumnCount), поскольку Access заполняет список сначала по строкам, а затем по столбцам. В этом нетрудно убедиться, изменив значение свойства Число столбцов (ColumnCount) списка на форме frmRowSource.

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

Select Case Me.grpChoice

    Case 1  ' Дни

        ' Вычислить дату последнего воскресенья.

        varStart = Now - WeekDay(Now)

        ' Перебор всех дней недели.

        For intI = 1 To 7

            strList = strList & ";" & Format(varStart + intI, "dddd")

        Next intI

    Case 2  ' Месяцы

        For intI = 1 To 12

            strList = strList & ";" & _

                      Format(DateSerial(1995, intI, 1), "mmmm")

        Next intI

End Select

' Удалить лишние символы "; " в начале.

strList = Mid(strList, 2)

Me.txtFillString = strList

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

воскресенье;понедельник;вторник;среда;четверг;пятница;суббота

либо перечень месяцев:

Январь;Февраль;Март;Апрель;Май;Июнь;Июль;Август;Сентябрь;Октябрь;_

 Ноябрь;Декабрь

После построения строки остается убедиться в том, что свойству RowSourceType задано правильное значение, и задать новое значение RowSource:

lstChangeRowSource.RowSourceType = "Value List"

lstChangeRowSource.RowSource = strList

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

Если вы еще не перешли на Access 2002, максимальная длина свойства RowSource равна 2048 символам. Если объем данных превышают этот порог, этот способ вам не подойдет. В Access 2002 и более поздних версиях подобной проблемы быть не должно, поскольку максимальная длина свойства RowSource заметно увеличена. Впрочем, в этих версиях все равно лучше использовать метод AddItem.

Заполнение списка функцией обратного вызова

Следующая методика основана на создании специальной функции Access Basic, которая предоставляет информацию, необходимую для заполнения списка. К сожалению, в учебниках по Access эта возможность документирована недостаточно хорошо. Решение, основанное на использовании функции обратного вызова, чрезвычайно гибко, и при этом реализовать его совсем несложно.

Идея проста: вы передаете Access функцию, которая должна возвращать информацию о содержимом заполняемого элемента. Access «задает вопросы» о количестве строк, количестве столбцов, ширине и формате столбцов, а также запрашивает сами данные. Ваша функция должна отреагировать на все запросы и предоставить сведения, на основании которых Access заполнит элемент данными. Это единственный пример того, как в Access программист определяет функцию, которая не вызывается из конкретных точек его программы. Access вызовет функцию, когда возникнет необходимость в информации для заполнения элемента (поэтому функция называется функцией обратного вызова ). Форма frmFillList использует две такие функции для заполнения двух списков.

Чтобы функция могла взаимодействовать с Access, она должна получать пять параметров, интерпретируемых определенным образом. В табл. 7.4 перечислены эти параметры с краткими описаниями. Имена параметров выбираются произвольно, в таблице они приведены только для удобства, однако порядок передачи параметров имеет принципиальное значение - параметры должны передаваться в порядке их перечисления в табл. 7.4.

Таблица 7.4. Обязательные параметры для функций обратного вызова

В последнем параметре intCode Access указывает, какую информацию должна вернуть функция. Ваша программа должна среагировать на запрос и вернуть соответствующее значение. В табл. 7.5 перечислены допустимые значения intCode в виде констант с краткими описаниями, а также значения, которые функция должна вернуть Access при получении каждого запроса.

Таблица 7.5. Значения параметра intCode, их интерпретация и возвращаемые значения

Практически все функции обратного вызова, используемые при заполнении списков, строятся по одному образцу, поэтому вы можете взять за основу функцию ListFillSkeleton. Функция получает правильный набор параметров и содержит команду Select Case с отдельными секциями Case для всех значений intCode, используемых на практике. Вам остается лишь изменить имя функции и сделать так, чтобы она возвращала полезные данные. Код функции ListFillSkeleton приведен ниже.

Function ListFillSkeleton(ctl As Control, varId As Variant, _

  lngRow As Long, lngCol As Long, intCode As Integer) As Variant

    Dim varRetval As Variant

    Select Case intCode

        Case acLBInitialize

            ' Инициализация

            varRetval = True

        Case acLBOpen

            ' Уникальный идентификатор

            varRetval = Timer

        Case acLBGetRowCount

            ' Количество строк в списке

        Case acLBGetColumnCount

            ' Количество столбцов в списке

        Case acLBGetValue

            ' Значение на пересечении заданной строки и столбца

        Case acLBGetColumnWidth

            ' Ширина столбца в твипах (не обязательно)

        Case acLBGetFormat

            ' Формат столбца (не обязательно)

        Case acLBEnd

            ' Завершающие действия, если они нужны

            ' (не обязательно, кроме освобождения памяти

            ' используемого массива)

    End Select

    ListFillSkeleton = varRetval

End Function

Ниже приведена функция ListFill1 формы frmListFill1, заполняющая первый список на форме. Согласно данным, передаваемым функцией, список состоит из двух столбцов, второй столбец скрывается (его ширина равна 0 твипов). Каждый раз, когда Access вызывает эту функцию с параметром intCode, равным acLBGetValue, функция вычисляет и возвращает новую дату. Ниже приведен полный код функции ListFill1.

Private Function ListFill1( ctl As Control, varId As Variant, _

  lngRow As Long, lngCol As Long, intCode As Integer)

    Select Case intCode

        Case acLBInitialize

            ' Инициализация

            ListFill1 = True

        Case acLBOpen

            ' Уникальный идентификатор

            ListFill1 = Timer

        Case acLBGetRowCount

            ' Количество строк в списке

            ListFill1 = 7

        Case acLBGetColumnCount

            ' Количество столбцов в списке

            ' В первом столбце выводится день недели,

            ' а во втором (скрытом) - дата.

            ListFill1 = 2

        Case acLBGetColumnWidth

            ' Ширина столбца в твипах (не обязательно)

            ' Ширина второго столбца равна 0.

            ' Помните - нумерация столбцов начинается с 0!

            If lngCol = 1 Then ListFill1 = 0

        Case acLBGetFormat

            ' Формат столбца (не обязательно)

            ' Формат первого столбца задается таким образом,

            ' чтобы в нем выводилось название дня недели.

            If lngCol = 0 Then

                ListFill1 = "dddd"

            Else

                ListFill1 = "mm/dd/yy"

            End If

        Case acLBGetValue

            ' Значение на пересечении заданной строки и столбца

            ' Независимо от столбца вернуть дату,

            ' удаленную от текущей на lngRow дней.

            ListFill1 = Now + lngRow

        Case acLBEnd

            ' Завершающие действия

    End Select

End Function

Следующая функция заполняет второй список на форме frmListFill1. На стадии инициализации (acLBInitialize) она сохраняет данные в массиве, а при запросе данных (acLBGetValue) возвращает элементы массива. Функция ListFill2 отображает ближайшие четыре даты, на которые приходится указанный день недели. Иначе говоря, если в первом списке был выбран понедельник, функция заполняет второй список датой понедельника текущей недели и датами следующих трех понедельников. Код ListFill2 приведен ниже.

Private Function ListFill2( ctl As Control, varId As Variant, _

  lngRow As Long, lngCol As Long, intCode As Integer)

Const MAXDATES = 4

    Static varStartDate As Variant

    Static adtm (0 To MAXDATES) As Date

    Dim intI As Integer

    Dim varRetval As Variant

    Select Case intCode

        Case acLBInitialize

            ' Инициализация

            ' Выполнить инициализацию. В эту секцию включается

            ' код, который должен выполняться только один раз.

            varStartDate = Me.lstTest1

            If Not IsNull(varStartDate) Then

                For intI = 0 To MAXDATES - 1

                    adtmDates(intI) = DateAdd("d", 7 * intI, varStartDate)

                Next intI

                varRetval = True

            Else

                varRetval = False

            End If

        Case acLBOpen

            ' Уникальный идентификатор

            varRetval = Timer

        Case acLBGetRowCount

            ' Количество строк в списке

            varRetval = MAXDATES

        Case acLBGetFormat

            ' Формат столбца (не обязательно)

            varRetval = "mm/dd/yy"

        Case acLBGetValue

            ' Значение на пересечении заданной строки и столбца

            varRetval = adtmDates(lngRow)

        Case acLBEnd

            ' Завершающие действия

            Erase adtmDates

    End Select

    ListFill2 = varRetval

End Function

Обратите внимание: массив adtmDates, заполняемый функцией, объявляется статическим. Статическая переменная, объявленная в функции, сохраняет свое значение между вызовами этой функции. Поскольку функция заполняет массив в секции acLBInitialize, но не использует его до запроса acLBGetValue, массив adtmDates должен «пережить» выход из функции. Если массив заполняется данными, которые в дальнейшем определяют содержимое элементов списка, очень важно объявить этот массив статическим.

Также следует учесть то обстоятельство, что Access вызывает секцию acLBInitialize только один раз, а секция acLBGetValue вызывается, по крайней мере, один раз для каждого отображаемого элемента списка. Если вы собираетесь проделать сколько-нибудь заметную работу по вычислению отображаемых данных, поместите все продолжительные расчеты в секцию acLBInitialize и постарайтесь сделать секцию acLBGetValue как можно короче. При больших объемах вычисляемых и отображаемых данных подобная оптимизацияоптимизация дает весьма заметный эффект.

В функции ListFill2 следует обратить внимание на три обстоятельства.

Как правило, когда Access запрашивает количество строк в элементе (то есть в том случае, если параметр intCode равен acLBGetRowCount), программа может вернуть точное значение. Но в некоторых ситуациях количество строк неизвестно или, по крайней мере, его трудно узнать. Например, если список заполняется по результатам запроса, возвращающего большое количество записей, было бы нежелательно вызывать метод MoveLast, методMoveLast для определения количества записей в результатах запроса - Access придется перебрать все записи, возвращенные запросом, что приведет к слишком заметному увеличению времени загрузки. Вместо этого для константы acLBGetRowCount функция возвращает значение -1. С точки зрения Access это означает, что информация о количестве записей будет получена позднее. При вызове функции с константой acLBGetValue возвращайте данные до их полного исчерпания. Как только в результате очередного вызова будет получено значение Null, Access поймет, что данных больше нет.

Впрочем, у этого приема тоже есть свои недостатки. Хотя он позволяет немедленно заполнить список данными, вертикальная полоса прокрутки начинает нормально работать лишь после того, как список будет прокручен до конца. Если вы готовы смириться с этим побочным эффектом, возврат -1 при запросе acLBGetRowCount значительно ускоряет загрузку больших объемов данных в списки и поля со списками.

При вызове функции с кодом acLBGetColumnWidth можно задавать разные значения для разных столбцов, определяемых параметром lngCol. Чтобы преобразовать некоторую величину из дюймов в твипы, следует умножить ее на 1440. Например, если ширина столбца должна составлять 0,5 дюйма, функция должна вернуть 0,5 ´ 1440.

Возникает резонный вопрос: в каких ситуациях следует применять каждый из этих приемов? В Access 2002 и более поздних версиях стоит по возможности ограничиваться методом AddItem. Во внутренней реализации этого метода задействован практически тот же код, который бы вы написали для прямой модификации свойства RowSource (в Access 2002 и выше вам никогда не придется изменять RowSource вручную - вызовы методов AddItem и RemoveItem делают то же самое). Однако следует помнить, что значение свойства RowSource ограничено по длине. Для больших (вероятно - многостолбцовых) списков максимального размера может оказаться недостаточно, и тогда приходится использовать решение с функцией обратного вызова. Если вы работаете в Access 2000 или более ранней версии, вам придется использовать решение с функциями обратного вызова для сложных списков или организовать модификацию свойства RowSource в более простых случаях.

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

Проблема

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

Решение

Задача решается двумя способами: передачейпроцедуры;передача параметров массива в качестве параметра или передачей списка, разделенного запятыми, преобразуемого в массив. Все элементы массива должны относиться к одному типу, но объявление массива с типом Variant позволяет передать массив разнотипных элементов. В следующем решении продемонстрированы оба приема.

Откройте модуль basArrays базы данных 07-06.MDB в режиме конструктора и выполните следующие действия.

1.Откройте окно отладки командой View4Immediate Window. В нашем примере весь код будет выполняться из окна отладки без использования форм.

2.Процедура UCaseArray получает список слов и преобразует его к верхнему регистру. Чтобы протестировать ее, введите в окне отладки следующую команду:

    ? TestUCase 5

3.Вместо 5 можно задать любое значение от 1 до 26. Процедура TestUCase генерирует заданное количество строк, сохраняет их в массиве и затем вызывает процедуру UCaseArray, которая преобразует все строки, хранящиеся в массиве, к верхнему регистру. Тестовая процедура выводит обе версии массива, исходную и преобразованную. Сколько бы строк ни передавалось процедуре UCaseArray для обработки, она успешно преобразует все переданные строки. Пример вызова этой процедуры показан на рис. 7.9.

Рис. 7.9. Процедура TestUCase с преобразованными строками

4.Следующая процедура получает несколько числовых аргументов и суммирует их. Процедура SumThemUp получает массив целых чисел, вычисляет и возвращает их сумму. Чтобы протестировать ее, введите в окне отладки следующую команду:

    ? TestSum 15

5.Вместо 15 можно задать любое число от 1 до 20. Процедура TestSum генерирует массив случайных чисел в интервале от 1 до 9 и передает его SumThemUp для обработки. На рис. 7.10 показан результат вызова процедуры TestSum для 15 значений.

6.Следующая процедура вместо массива получает список значений, для чего в объявление включается модификатор ParamArray, ключевое словоParamArray. Вызовите функцию MinValue модуля basArrays и передайте ей список значений, разделенных запятыми; функция возвращает наименьшее число из указанного списка. Например, следующая команда присваивает переменной varMin значение -10, наименьшее из трех переданных чисел:

    varMin= MinValue(0, -10, 15)

Рис. 7.10. Процедура TestSum суммирует 15 чисел

7.Процедуры UCaseArray и SumThemUp получают параметр типа Variant. В переменных этого типа может храниться как одно значение, так и целый массив значений. На стороне вызова процедуре можно передать как значение типа Variant, так и массив значений. Чтобы передать массив, следует добавить завершающую пару круглых скобок (), наличие которых сообщает Access о том, что переменная представляет массив. Таким образом, вызов функции SumThemUp с передачей параметра-массива aintValues должен выглядеть так (обратите внимание на круглые скобки в имени массива):

    varSum = SumThemUp(aintValues())

8.В объявлении процедуры параметр-массив также должен снабжаться круглыми скобками:

    Public Function SumThemUp (aintValues() As Integer) As Variant

9.В этом случае может передаваться только массив. Также возможны объявления вида:

    Public Function SumThemUp (varValues() As Variant) As Variant

10.При таком объявлении можно передать как одно значение типа Variant, так и массив.

11.После получения массива процедуре требуются средства для перебора его элементов. В Access предусмотрено два способа перебора: цикл For…Next, командаFor…Next (с числовой индексацией) и цикл For Each…Next, командаFor Each…Next (без индексации). В процедуре UCaseArray элементы массива перебираются первым способом, а в процедуре SumThemUp - вторым.

12.Чтобы перебрать содержимое массива по индексам элементов, необходимо знать границы массива, то есть минимальное и максимальное значения индекса. В Access эту информацию можно получить при помощи функций LBound, функцияLBound и UBound, функцияUBound. Процедура UCaseArray содержит фрагмент следующего вида:

    For intI = LBound(varValues) To UBound(varValues)

        varValues(intI) = UCase(varValues(intI))

    Next intI

13.Цикл перебирает все элементы массива независимо от конкретных значений индексов начального и конечного элементов. В Basic при объявлении массива можно выбрать любые индексы начального и конечного элементов. Допустим, массив объявлен командой вида:

    Dim avarArray(13 To 97) As Integer

14.В этом случае перебор всех элементов должен осуществляться с изменением цикла от 13 до 97. Функции LBound и UBound позволяют создавать универсальные процедуры с перебором всего содержимого массива даже в том случае, если границы массива неизвестны заранее.

15.Процедура UCaseArray устроена просто: определив, что входное значение представляет собой массив (при помощи функции IsArray, функцияIsArray), она перебирает все элементы переданного массива и преобразует их к верхнему регистру. Массив передается по ссылке, то есть изменения в нем распространяются и на процедуру, из которой поступил вызов. Код функции UCaseArray приводится ниже.

    Public Sub UCaseArray(ByRef varValues As Variant)

        ' Преобразование переданного массива к верхнему регистру.

        Dim intI As Integer

        If IsArray(varValues) Then

            For intI = LBound(varValues) To UBound(varValues)

                varValues(intI) = UCase(varValues(intI))

            Next intI

        Else

            varValues = UCase(varValues)

        End If

    End Sub

16.Функция SumThemUp устроена также просто. Все элементы массива перебираются в цикле ForEach…Next; переменной varItem присваивается значение текущего элемента массива, которое прибавляется к накапливаемой сумме в переменной varSum. Ниже приведен код функции SumThemUp.

    Public Function SumThemUp(varValues As Variant) As Variant

        ' Вычисление суммы переданных значений.

        Dim varItem As Variant

        Dim varSum As Variant

        varSum = 0

        If IsArray(varValues) Then

            For Each varItem In varValues

                varSum = varSum + varItem

            Next varItem

        Else

            varSum = varValues

        End If

        SumThemUp = varSum

    End Function

17.Передать список, преобразуемый в массив, ничуть не сложнее. Чтобы использовать эту возможность, объявите формальные параметры процедуры таким образом, чтобы список передавался на последнем месте. Используйте ключевое слово ParamArray, чтобы список интерпретировался как массив, и объявите параметр-массив с типом Variant:

    Public Function MinValue(ParamArray varValues() As Variant) As Variant

18.Параметр-массив обрабатывается внутри процедуры точно так же, как любой другой массив. Иначе говоря, вы можете организовать перебор элементов в границах от LBound до UBound или воспользоваться циклом For Each…Next.

Комментарий

Если вы собираетесь пользоваться этой методикой, помните, что элементы массивов, создаваемых в Access, индексируются с нуля, если в программе не указано обратное. Некоторые программисты настаивают на том, что индексация массивов должна начинаться с 1, и поэтому включают директиву Option Base 1, директиваOption Base 1 в секцию объявлений своих модулей. Других вполне устраивает, что индексация начинается с 0; третьи оставляют нижнюю границу по умолчанию (то есть ноль), но не используют элемент с нулевым индексом. Никогда не делайте никаких допущений относительно нижней и верхней границ массива, когда-нибудь это нарушит работу ваших обобщенных процедур. Если ваш код должен вызываться другими программистами, также необходимо учитывать существование разных подходов к выбору нижней границы при индексации.

Если вы предпочитаете перебирать элементы массива в цикле For Each…Next, как переменная цикла, так и сам массив должны быть объявлены с типом Variant. Кроме того, следует учитывать, что конструкция For Each…Next не позволяет задавать значения элементов массива; ее возможности ограничиваются чтением. Если вы захотите перебрать элементы массива и присвоить им новые значения, необходимо использовать стандартный синтаксис For…Next с числовым счетчиком.

В Access 2000 и более поздних версиях функции могут возвращать массивы. В этом случае процедура UCaseArray записывается в следующем виде:

Public Function UCaseArrayFunc(ByVal varValues As Variant) As String()

    ' Преобразование всего переданного массива к верхнему регистру.

    Dim intI As Integer

    Dim strWorking() As String

    If IsArray(varValues) Then

        ReDim astrWorking(LBound(varValues) To UBound(varValues))

        For intI = LBound(varValues) To UBound(varValues)

            astrWorking(intI) = CStr(UCase(varValues(intI)))

        Next intI

        UCaseArrayFunc = astrWorking

    End If

End Function

Преимущества такого способа заключаются в том, что функция возвращает результаты во втором массиве, а исходный массив varValues остается без изменений. В отличие от функции UCaseArray массив передается по значению, то есть UCaseArrayFunc работает с копией исходного массива. Любые изменения, вносимые внутри UCaseArrayFunc, относятся только к этой копии, а исходный массив в вызывающей процедуре остается в прежнем состоянии.

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

Проблема

Access ориентируется на работу с базами данных, но в этой СУБД не предусмотрены средства сортировки массивов. Ваше приложение должно работать с отсортированным массивом, но при этом неясно, как отсортировать данные без сохранения в таблице. В других языках существуют специальные методы сортировки массивов. Как написать эффективную процедуру сортировки массива?

Решение

Действительно, в Access не существует встроенных средств сортировки сортировка;массивовмассивов. В библиотеках можно найти целые тома, посвященные различным алгоритмам сортировки и поиска, но для организации сортировки массивов в Access не нужно искать так глубоко. Большие наборы данных обычно хранятся в таблицах, поэтому массивы Access обычно не слишком велики, и для них подходит почти любой алгоритм сортировки. В представленном решении используется одна из разновидностей стандартного алгоритма быстрая сортировкаалгоритмы;быстрая сортировкабыстрой сортировки (за дополнительной информацией об алгоритмах сортировки и поиска обращайтесь к специализированной литературе, но учтите - это очень обширная тема!).

Чтобы испытать средства сортировки на практике, загрузите модуль basSortDemo из базы данных 07-07.MDB. Введите в окне отладки команду

TestSort 6

Числовой параметр (любое число от 1 до 20) определяет количество сортируемых случайных целых чисел в интервале от 1 до 99. Процедура TestSort создает массив целых чисел и передает его VisSortArray - особой версии процедуры сортировки acbSortArray, которая выводит информацию о выполняемых операциях. На рис. 7.11 представлены примерные результаты запуска процедуры.

Чтобы использовать средства сортировки в своем приложении, выполните следующие действия.

1.Импортируйте модуль basSortArray в свое приложение.

2.Создайте массив, который необходимо отсортировать. Массив должен содержать элементы типа Variant, но в них могут храниться любые данные; в приведенном решении элементы массива относятся к типу Integer, а в следующем разделе «Заполнение списка именами файлов» используются массивы типа String.

3.Вызовите процедуру acbSortArray и передайте ей имя сортируемого массива. Например, сортировка массива avarStates выполняется следующей командой:

    acbSortArray avarStates()

4.После вызова acbSortArray массив будет успешно отсортирован. Помните, что сортировка осуществляется «на месте»: после того как массив будет отсортирован, вы уже не сможете вернуться к прежнему состоянию! Если вы предпочитаете сохранить исходный массив, сначала создайте копию.

Рис. 7.11. Результаты запуска процедуры TestSort

Комментарий

Алгоритм быстрой сортировки основан на многократном разбиении массива и последовательной сортировке полученных фрагментов до тех пор, пока каждый фрагмент не будет состоять из одного элемента. Процедура acbSortArray вызывает главную процедуру сортировки QuickSort и передает ей начальный и конечный индекс сортируемых элементов. Процедура QuickSort разбивает массив надвое, а затем вызывает сама себя для каждой половины.

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

Код процедуры QuickSort выглядит так:

Private Sub QuickSort(varArray As Variant, _

  intLeft As Integer, intRight As Integer)

    Dim i As Integer

    Dim j As Integer

    Dim varTestVal As Variant

    Dim intMid As Integer

    If intLeft < intRight Then

        intMid = (intLeft + intRight) \ 2

        varTestVal = varArray(intMid)

        i = intLeft

        j = intRight

        Do

            Do While varArray(i) < varTestVal

                i = i + 1

            Loop

            Do While varArray(j) > varTestVal

                j = j - 1

            Loop

            If i <= j Then

                SwapElements varArray(), i, j

                i = i + 1

                j = j - 1

            End If

        Loop Until i > j

        ' Чтобы оптимизировать сортировку, мы всегда начинаем

        ' с меньшего из двух сегментов.

        If j <= intMid Then

            QuickSort varArray(), intLeft, j

            QuickSort varArray(), i, intRight

        Else

            QuickSort varArray(), i, intRight

            QuickSort varArray(), intLeft, j

        End If

    End If

End Sub

Ниже приведено подробное описание базового алгоритма процедуры QuickSort. Переменная intLeft обозначает начальный, а переменная intRight - конечный индекс сортируемого интервала.

1.Если intLeft не меньше intRight, сортировка завершена.

2.Выбрать один из элементов сортируемого подмножества, по которому производится разбиение интервала. Существуют различные мнения по поводу того, как следует выбирать промежуточный элемент; в приведенной версии алгоритма используется элемент, расположенный в середине заданного интервала:

    intMid = (intLeft + intRight) \ 2

    varTestVal = varArray(intMid)

3.Начать перебор слева и перебирать элементы массива до тех пор, пока не будет найден элемент, не меньший промежуточного элемента. Перебор завершится на промежуточном элементе (который заведомо не меньше себя):

    Do While varArray(i) < varTestVal

        i = i + 1

    Loop

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

    Do While varArray(j) > varTestVal

        j = j - 1

    Loop

5.Если позиция, найденная на шаге 3, меньше либо равна позиции, найденной на шаге 4, процедура сортировки меняет элементы местами, увеличивает индекс шага 3 и уменьшает индекс шага 4:

    If i <= j Then

        SwapElements varArray(), i, j

        i = i + 1

        j = j - 1

    End If

6.Повторять шаги 3-5 до тех пор, пока индекс, полученный на шаге 3, не станет больше индекса, полученного на шаге 4 (i>j). В результате все элементы, расположенные слева от промежуточного элемента, меньше его либо равны ему, а все элементы справа - больше или равны.

7.Повторить все описанные выше действия с каждой из двух частей (начиная с меньшей) до тех пор, пока не будет выполнено условие на шаге 1.

    If j <= intMid Then

        QuickSort varArray(), intLeft, j

        QuickSort varArray(), i, intRight

    Else

        QuickSort varArray(), i, intRight

        QuickSort varArray(), intLeft, j

    End If

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

См. также

Пример практического использования процедуры QuickSort приведен в следующем разделе.

Заполнение списка именами файлов

Проблема

Требуется создать отсортированныйимена файлов;сортировка список файлов с заданным расширением, находящихся в определенном каталоге. В Access существует функция Dir, функцияDir, но при этом непонятно, как сохранить полученную информацию в списке. Можно ли это сделать?

Решение

Задача идеально подходит для того, чтобы применить на практике материал трех предыдущих разделов. В ней реализованы заполнениефайлы;заполнение списковсписки;заполнение именами файлов списка функцией обратного вызова, передача параметров-массивов и сортировка массива. Кроме того, ниже продемонстрирована методика заполнения массива перечнем файлов, полученным при помощи функции Dir.

Откройте базу данных 07-08.MDB и запустите форму frmTestFillDirList. Введите в текстовом поле файловую спецификацию (например, c:\*.exe). При выходе из текстового поля (по нажатию клавиши Tab или Enter) процедура обработки события AfterUpdate, событиеAfterUpdate заполняет список соответствующими именами файлов. На рис. 7.12 показан результат поиска для маски c:\*.*.

Рис. 7.12. Форма frmTestFillDirList c перечнем exe-файлов в каталоге Windows

Чтобы реализовать аналогичную возможность в своем приложении, выполните следующие действия.

1.Создайте на форме текстовое поле и список. Задайте значения их свойств, указанные в табл. 7.6.

Таблица 7.6. Значения свойств элементов формы

2.Включите следующий фрагмент в процедуру обработки события AfterUpdate текстового поля:

    Private Sub txtFileSpec_AfterUpdate()

        Me.lstDirList.Requery

    End Sub

3.Процедура заново заполняет данными список в тот момент, когда пользователь вводит значение в текстовом поле, а затем передает фокус другому элементу.

4.Включите следующий фрагмент в процедуру обработки события AfterUpdate списка:

    Private Sub lstDirList_AfterUpdate()

        MsgBox "You chose: " & Me.lstDirList

    End Sub

5.Процедура отображает окно сообщения, в котором указывается имя выбранного файла.

6.Включите приведенную ниже функцию FillDirList в глобальный модуль, чтобы сделать ее доступной для всех форм базы данных. Хотя функция нормально работает в модуле формы, она имеет достаточно общий характер, что позволяет включить ее в глобальный модуль и копировать из одной базы данных в другую. Функция FillDirList заполняет данными список на форме.

    Public Function FillDirList(ByVal strFileSpec As String, _

      astrFiles() As String) As Integer

        ' Заполнение динамического массива, передаваемого в параметре

        ' astrFiles(), по файловой спецификации strFileSpec.

        Dim intNumFiles As Integer

        Dim strTemp As Variant

        On Error GoTo HandleErr

        intNumFiles = 0

        ' Задать файловую спецификацию для Dir() и получить первое имя файла.

        strTemp = Dir(strFileSpec)

        Do While Len(strTemp) > 0

            intNumFiles = intNumFiles + 1

            astrFiles(intNumFiles - 1) = strTemp

            strTemp = Dir

        Loop

    ExitHere:

        If intNumFiles > 0 Then

            ReDim Preserve astrFiles(intNumFiles - 1)

            acbSortArray astrFiles()

        End If

        FillDirList = intNumFiles

        Exit Function

    HandleErr:

        Select Case Err.Number

            Case 9

                ' Необходимо изменить размеры массива.

                ' Зарезервировать место еще для 100 файлов.

                ReDim Preserve astrFiles(intNumFiles + 100)

                Resume

            Case Else

                FillDirList = intNumFiles

                Resume ExitHere

        End Select

    End Function

ВНИМАНИЕ

Вместо того чтобы изменять размер массива для каждого файла, функция FillDirList перехватывает ошибку переполнения массива и резервирует место сразу для 100 файлов. Выполнение команды ReDim Preserve в VBA обходится относительно дорого, поэтому эта команда должна вызываться как можно реже. В настоящем примере массив усекается до фактического размера после получения всех имен файлов.

7.Импортируйте модуль basSortArray из базы данных 07-08.MDB. В нем содержится код сортировки, использовавшийся в разделе «Сортировка массива в VBA».

Комментарий

В нашем примере функция обратного вызова FillList поставляет данные для заполнения списка (функции обратного вызова описаны в разделе «Программное добавление строк в список или поле со списком»). Код функции выглядит так:

Private Function FillList(ctl As Control, _

  varID As Variant, lngRow As Long, lngCol As Long, _

  intCode As Integer)

    Static astrFiles() As String

    Static intFileCount As Integer

    Select Case intCode

        Case acLBInitialize

            If Not IsNull(Me.txtFileSpec) Then

                intFileCount = FillDirList(Me.txtFileSpec, astrFiles())

            End If

            FillList = True

        Case acLBOpen

            FillList = Timer

        Case acLBGetRowCount

            FillList = intFileCount

        Case acLBGetValue

            FillList = astrFiles(lngRow)

        Case acLBEnd

            Erase astrFiles

    End Select

End Function

В секции acLBInitialize функции FillList вызывается функция FillDirList, заполняющая массив astrFiles на основании содержимого текстового поля txtFileSpec. Функция FillDirList заполняет массив, попутно вызывая процедуру acbSortArray для сортировки списка файлов, и возвращает количество найденных файлов. При получении запроса acLBGetValue функция FillList возвращает запрашиваемый элемент массива. При обработке запроса acLBGetRowCount используется значение, возвращаемое функцией FillDirList (количество найденных файлов).

В функциях FillList и FillDirList заслуживает внимания одно интересное обстоятельство. Функция FillList объявляет динамические массивыдинамический массив astrFiles, но без указания размера, поскольку количество найденных файлов еще не известно. Массив передается функции FillDirList, которая последовательно заполняет его именами файлов по указанной спецификации до тех пор, пока очередная попытка не завершится неудачей. Функция FillDirList возвращает количество имен файлов, однако имеются и побочные эффекты - определение размера массива и его заполнение. Ниже приведен фрагмент кода, в котором это происходит.

' Задать файловую спецификацию для Dir() и получить первое имя файла.

strTemp = Dir(strFileSpec)

Do While Len(strTemp) > 0

    intNumFiles = intNumFiles + 1

    astrFiles(intNumFiles - 1) = strTemp

    strTemp = Dir

Loop

Функция FillDirList создает список файлов при помощи функции Dir. Особенность этой функции заключается в том, что она вызывается несколько раз. При первом вызове функции передается файловая спецификация, по которой производится поиск, и Dir возвращает первое найденное имя файла. Если функция вернет непустое значение, она в цикле вызывается без параметров до тех пор, пока не будет возвращена пустая строка. При каждом вызове функция Dir возвращает следующий найденный файл.

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

If intNumFiles > 0 Then

    ReDim Preserve astrFiles(intNumFiles - 1)

    acbSortArray astrFiles()

End If

FillDirList = intNumFiles

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

Общие операции со свойствами объектов

Проблема

У вас возникают проблемы с чтением и заданием свойствсвойства. Все выглядит так, словно в Access существуют разные типы свойств, и решение, работающее для одного объекта и свойства, не подходит для другой ситуации. Как решить эту проблему раз и навсегда?

Решение

В Access существует две категории свойств объектов. Встроенные свойства существуют всегда, а пользовательские свойства объекта создаются программой или Access по запросу. Синтаксис ссылок на свойства разных категорий различается, однако описанный в настоящем решении способ подходит для любого типа. В качестве примера в нем рассматривается пользовательское свойство Description, но методика с таким же успехом будет работать с любым свойством. Обратите внимание: свойство Description не является встроенным, поэтому попытка сослаться на него с использованием стандартного синтаксиса объект . свойство завершается неудачей.

Форма, используемая в решении, предназначена только для демонстрационных целей. Вся основная работа выполняется модулем basHandleProperties, содержащим процедуры для чтения и задания любых свойств. Откройте базу данных 07-09.MDB и запустите форму frmTestProperties (рис. 7.13); выберите таблицу в списке. Обратите внимание на описание таблицы, отображаемое в поле Description под списком. Если выбрать поле таблицы в списке справа, его описание также появляется внизу. Если ввести новый текст описания, то процедура обработки события AfterUpdate, событиеAfterUpdate текстового поля запишет новое значение в свойство Description соответствующей таблицы или поля.

Рис. 7.13. Форма frmTestProperties позволяет задать и прочитать свойство Description любой таблицы или поля

Форма использует две функции модуля basHandleProperties, описанные в табл. 7.7. Эти функции позволяют задать или прочитать произвольное свойство любого объекта при условии, что объект уже обладает этими свойствами или позволяет создать их в случае необходимости.

Определение свойств разрешается только для базы данных;добавление свойствбаз данных, таблицы;добавление свойствтаблиц, запросы;добавление свойствзапросов, полей, индексы;добавление свойствиндексов и отношений. Попытки создания новых свойств в объектах других типов завершаются неудачей.

Таблица 7.7. Функции acbGetProperty и acbSetProperty

Чтобы использовать эти функции в приложении, выполните следующие действия.

1.Импортируйте модуль basHandleProperties в свое приложение.

2.Значение свойства задается функцией acbSetProperty. При вызове функция возвращает старое значение свойства. Пример:

    Dim db As DAO.Database

    Dim varOldDescription As Variant

    Set db = CurrentDb()

    var OldDescription = acbSetProperty(db, "Description", _

                            "Sample Database")

    If Not IsNull(varOldDescription) Then

        MsgBox "The old Description was: " & varOldDescription

    End If

3.Чтение свойств осуществляется функцией acbGetProperty. Пример:

    Dim db As DAO.Database

    Dim varDescription As Variant

    Set db = CurrentDb()

    var Description = acbGetProperty(db, "Description")

    If Not IsNull(varDescription) Then

        MsgBox "The database description is: " & varDescription

    End If

Комментарий

Свойства в Access делятся на две категории: встроенные и пользовательские. Встроенные свойства существуют всегда и являются частью определения объекта. Например, свойства Name и Type абсолютно необходимы для работы большинства объектов, поэтому они объявлены как встроенные. С другой стороны, ядро Jet позволяет создавать новые свойства и включать их в коллекцию Properties всех поддерживаемых объектов, включая TableDefs, QueryDefs, Index, объектIndex, Field, Relation и Container. Эти свойства являются пользовательскими.

Кроме того, Access как клиент ядра Jet самостоятельно определяет ряд свойств. Например, если щелкнуть правой кнопкой мыши на объекте в окне базы данных и выбрать в контекстном меню команду Properties, Access позволит ввести описание объекта, определяемое свойством Description. Свойство Description не существует, пока вы не прикажете Access создать его при помощи диалогового окна или кода Access Basic. То же самое относится к свойствам Caption, свойство;текстовые поляCaption, ValidationRule, свойствоValidationRule и DefaultValue полей - они тоже не существуют, пока Access не создаст их по вашему требованию.

При попытке прочитать или задать значение несуществующего свойства происходит ошибка времени выполнения. Программа должна быть готова к обработке этой ошибки. Кроме того, многие программисты привыкли работать со встроенными свойствами, на которые можно ссылаться с использованием упрощенного синтаксиса объект . свойство . Такой синтаксис подходит только для встроенных свойств. Для пользовательских свойств (в том числе и определяемых Access) ссылка на свойство должна включать явную ссылку на коллекцию Properties, в которой это свойство хранится. Например, следующая команда задает значение свойства Format, свойствоFormat поля City таблицы tblCustomers (если свойство Format еще не задано, происходит ошибка времени выполнения):

CurrentDb.TableDefs("tblCustomers").

    Fields("City").Properties("Format") = ">"

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

CurrentDb.TableDefs("tblCustomers").Fields("City").AllowZeroLength = False

Но если потребуется создать для этого свойства явную ссылку, можно воспользоваться конструкцией вида:

CurrentDb.TableDefs("tblCustomers")._

    Fields("City").Properties("AllowZeroLength") = False

Именно возможность применения единого синтаксиса для встроенных и пользовательских свойств и была заложена в основу кода, входящего в данное решение.

Чтобы создать новое свойство, необходимо выполнить следующие действия.

1.Создайте новый объект свойства вызовом метода CreateProperty, методCreateProperty существующего объекта.

2.Задайте свойства созданного объекта, включая имя, тип и значение по умолчанию (этот шаг можно объединить с предыдущим, передав информацию при вызове CreateProperty).

3.Присоедините новое свойство к коллекции Properties объекта. Например, включение свойства Description, свойствоDescription в текущую базу данных может выполняться следующим образом:

    Dim db As DAO.Database

    Dim prp As Property

    Set db = CurrentDb()

    ' Шаг 1

    Set prp = db.CreateProperty()

    ' Шаг 2

    prp.Name = "Description"

    prp.Type = dbText

    tpt.Value = "Sample database"

    ' Шаг 3

    db.Properties.Append prp

4.Шаги 1 и 2 объединяются передачей атрибутов нового свойства в момент создания:

    ' Шаги 1 и 2

    Set prp = db.CreateProperty("Description", dbText, "Sample database")

    ' Шаг 3

    db.Properties.Append prp

5.После выполнения этих действий свойство Description базы данных может быть получено следующей конструкцией (обратите внимание на обязательное присутствие ссылки на коллекцию Properties, поскольку свойство Description является пользовательским):

Debug.Print CurrentDb.Properties!Description

Чтобы вам не приходилось постоянно учитывать различия в синтаксисе ссылок на пользовательские и встроенные свойства, а также помнить, создавалось ли ранее некоторое свойство для заданного объекта, в модуль basHandleProperties были включены функции acbGetProperty и acbSetProperty.

Функция acbGetProperty выполняет более простую задачу: она пытается получить значение свойства с указанным именем. Вызов acbGetProperty может завершиться неудачей по двум причинам: либо не существует сам объект, либо не существует запрашиваемое свойство (ошибки acbcErrNotIntCollection и acbcErrPropertyNotFound соответственно). При возникновении любой из этих ошибок функция возвращает Null. Если же происходит любая другая ошибка, перед возвращением Null функция отображает окно сообщения. Если же свойство было получено без ошибок, функция возвращает его значение. Пример использования функции acbGetProperty приведен выше в разделе «Решение» и в базе данных 07-09.MDB.

Код функции acbGetProperty:

Public Function acbGetProperty(obj As Object, _

        strProperty As String) As Variant

    ' Чтение свойства объекта

    ' Если свойство существует, функция возвращает его значение;

    ' в противном случае возвращается Null.

    On Error GoTo HandleErr

    acbGetProperty = obj.Properties(strProperty)

ExitHere:

    Exit Function

HandleErr:

    Select Case Err.Number

        Case 3265, 3270     ' Объект или свойство не существует

            ' Ничего не делать!

        Case Else

            MsgBox Err.Number & ": " & Err.Description, , "acbGetProperty"

    End Select

    acbGetProperty = Null

    Resume ExitHere

End Function

Функция acbSetProperty заслуживает большего внимания - она пытается задать значение указанного свойства. У нее имеется ряд интересных особенностей.

Ниже приведен код функции acbSetProperty.

Public Function acbSetProperty( _

  obj As Object, strProperty As String, varValue As Variant, _

  Optional propType As DataTypeEnum = dbText)

    On Error GoTo HandleErr

    Dim varOldValue As Variant

    ' Если свойство не существует, вызов завершается неудачей.

    varOldValue = obj.Properties(strProperty)

    obj.Properties(strProperty) = varValue

    acbSetProperty = varOldValue

ExitHere:

    Exit Function

HandleErr:

    Select Case Err.Number

        Case 3270       ' Свойство не найдено

            ' Если свойство не существует, попытаться создать его.

            If acbCreateProperty(obj, strProperty, varValue, _

              varPropType) Then

                Resume Next

            End If

        Case 3421       ' Ошибка преобразования типа данных

            MsgBox "Invalid data type!", vbExclamation, "acbSetProperty"

        Case Else

            MsgBox Err.Number & ": " & Err.Description, , "acbSetProperty"

    End Select

    acbSetProperty = Null

    Resume ExitHere

End Function

Новые свойства могут создаваться только для объектов, находящихся под управлением ядра Jet, ядроJet. Иначе говоря, включение свойств поддерживается коллекциями Properties объектов Database, объектыDatabase, TableDef, объектTableDef, QueryDef, объектQueryDef, Index, Field, Relation, объектRelation и Container, объектContainer. Новые свойства не могут определяться для объектов, находящихся под управлением Access (формы, отчеты и элементы). При попытке создания пользовательского свойства вызовом acbSetProperty для недопустимых объектов функция вернет Null. С другой стороны, функции acbSetProperty и acbGetProperty могут использоваться с любыми объектами Access, если ограничиться встроенными свойствами для объектов, не поддерживающих пользовательских свойств. Например, следующий фрагмент работает при открытой форме frmTestProperties:

If IsNull(acbSetProperty(Forms("frmTestProperties"), "Caption", _

  "Test Properties")) Then

    MsgBox "Unable to set the property!"

End If

Пользовательские свойства сохраняются между сеансами. Иначе говоря, эти свойства сохраняются в TableDefs вместе со встроенными свойствами, а также свойствами, определяемыми в Access. Пользовательские свойства удаляются методом Delete, методDelete родительской коллекции. Например, следующая команда удаляет созданное ранее пользовательское свойство:

CurrentDb.TableDefs("tblSuppliers").Fields("Address"). _

    Properties.Delete "SpecialHandling"

Проверка существования объекта

Проблема

В процессе работы приложение создает и удаляет различные объекты. В какой-то момент требуется узнать, существует ли тот или иной объект, и выполнить различные действия в зависимости от результата проверки. Но вы не можете найти в Access функции, которая бы проверяла, существует ли заданный объект. Может, вы чего-то не понимаете? Такая функция просто обязана входить в число базовых возможностей Access!

Решение

Нет, вы не ошибаетесь: в Access действительно не существует простых средств, при помощи которых можно было бы узнать, существует ли заданный объект. С другой стороны, это относительно просто сделать, если разбираться в двух важных концепциях: поддержке объектов DAO Container и механизме получения информации при обработке ошибок. В представленном решении эти концепции используются для создания функции, проверяющей существование объектов.

Откройте базу данных 07-10.MDB и запустите форму frmTestExist (рис. 7.14). Эта форма позволяет по имени и типу объекта проверить, существует ли этот объект. Конечно, вам не нужно использовать такие формы в своих приложениях - в нашем примере она просто иллюстрирует возможности функции acbDoesObjExist в модуле basExists базы данных 07-10.MDB. Чтобы с формой было удобнее работать, в табл. 7.8 перечислены объекты базы данных 07-10.MDB. Поэкспериментируйте с именами существующих и несуществующих объектов, с правильными и неправильными типами - вы убедитесь в том, что функция acbDoesObjExist хорошо справляется со своей задачей.

Рис. 7.14. Форма frmTestExist позволяет проверить, существует ли
заданный объект в базе данных

Таблица 7.8. Объекты базы данных 07-10.MDB

Чтобы использовать функцию acbDoesObjExist в своем приложении, выполните следующие действия.

1.Импортируйте модуль basExists из базы данных 07-10.MDB. Модуль содержит функцию acbDoesObjExist.

2.Вызовите функцию acbDoesObjExist, передайте ей имя и целочисленный признак типа объекта. Параметр типа должен выбираться из констант перечисляемого типа AcObjectType: acTable, acQuery, acForm, acReport, acMacro или acModule. Например, следующий вызов acbDoesObjExist проверяет существование таблицы с именем «Customers»:

       If acbDoesObjExist("Customers", acTable) Then

           ' Таблица существует

       Else

           MsgBox "The table 'Customers' doesn't exist!"

       End If

Комментарий

Функция acbDoesObjExist, полный код которой приводится ниже, проверяет существование объекта, пытаясь получить его свойство Name. Поскольку свойство Name поддерживается всеми существующими объектами, эта операция завершается неудачей только в том случае, если объект не существует. Упрощенная структура этого кода выглядит так:

  Dim strName As String

  On Error Goto acbDoesObjExist_Err

  strName = obj.Name

  acbDoesObjExist = True

acbDoesObjExist_Exit:

  Exit Function

acbDoesObjExist_Err:

  acbDoesObjExist = False

  Resume acbDoesObjExist_Exit

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

Остается найти ответ на последний вопрос - как по строке, содержащей имя объекта, и целочисленному признаку типа получить ссылку на объект? Именно здесь нам пригодятся объекты Container ядра Jet. Коллекция Container, поддерживаемая Access для того, чтобы ядро Jet могло обеспечивать защиту всех объектов Access, содержит коллекции объектов Document (по одному для каждого сохраненного объекта базы данных). В нее входят коллекции с именами Tables, коллекцияTables, Forms, коллекцияForms, Reports, коллекцияReports, Scripts, коллекцияScripts (для нас, пользователей, это макросы !) и Modules, коллекцияModules. Функция ищет в этих коллекциях документ с заданным именем. Исключение составляют таблицы и запросы - для них проще провести прямой поиск в коллекциях TableDefs и QueryDefs. Access объединяет таблицы и запросы в контейнере Tables, но разделяет их в коллекциях TableDefs и QueryDefs. Если бы функция перебирала элементы контейнера Tables, ей пришлось бы выполнять лишнюю проверку, чтобы отличить таблицы от запросов; при работе с коллекциями этого делать не нужно.

Ниже приведен код функции acbDoesObjExist.

Public Function acbDoesObjExist( _

  strObj As String, objectType As Integer)

    Dim db As DAO.Database

    Dim strCon As String

    Dim strName As String

    On Error GoTo HandleErr

    Set db = CurrentDb()

    Select Case objectType

        Case acTable

            strName = db.TableDefs(strObj).Name

        Case acQuery

            strName = db.QueryDefs(strObj).Name

        Case acForm, acReport, acMacro, acModule

            Select Case objectType

                Case acForm

                    strCon = "Forms"

                Case acReport

                    strCon = "Reports"

                Case acMacro

                    strCon = "Scripts"

                Case acModule

                    strCon = "Modules"

            End Select

            strName = db.Containers(strCon).Documents(strObj).Name

    End Select

    acbDoesObjExist = True

ExitHere:

    Exit Function

HandleErr:

    acbDoesObjExist = False

    Resume ExitHere

End Function

Команда Select Case, командаSelect Case сначала проверяет, не является ли проверяемый объект таблицей или запросом, и если является - производит поиск в соответствующей коллекции:

Select Case objectType

    Case acTable

        strName = db.TableDefs(strObj).Name

    Case acQuery

        strName = db.QueryDefs(strObj).Name

    .

    .

    .

End Select

Если объект относится к другому типу, функция присваивает имя контейнера переменной strCon и затем пытается получить свойство Name, свойство;объектыName документа в этом контейнере:

Case acForm, acReport, acMacro, acModule

    Select Case objectType

        Case acForm

            strCon = "Forms"

        Case acReport

            strCon = "Reports"

        Case acMacro

            strCon = "Scripts"

        Case acModule

            strCon = "Modules"

    End Select

    strName = db.Containers(strCon).Documents(strObj).Name