Советы тем, кто программирует на VB & VBA
Совет 379. Преобразование последовательности байтов в строку шестнадцатеричных символов
Совет 380. Используйте автоматически запускаемые макросы Word
Совет 381. Создание строки меню
Совет 382. Как узнать значение свойств документа Word
Совет 383. Копирование набора данных в XLS-файл с помощью метода CopyFromRecordset
Совет 384. Использование Script Control в VBA
Совет 385. На что нужно обратить внимание при замере интервалов времени
Совет 386. Не применяйте неявного преобразования данных
Совет 387. Передача XML-данных в виде атрибутов
Совет 379. Преобразование последовательности байтов в строку шестнадцатеричных символов
Для визуализации информации можно представить последовательность двоичных байтов в виде строки шестнадцатеричных символов (каждый байт представлен парой таких символов). Решение у этой задачи достаточно простое, но следует помнить, что в VB строка может содержать как произвольную последовательность байтов (иначе говоря, символов в однобайтной ANSI-кодировке), так и набор Unicode-символов (этот вариант используется в 32-разрядных версиях VB). В последнем случае каждый символ будет занимать пару последовательных байтов.
Функция преобразования в шестнадцатеричный вид может быть реализована в таком виде:
Public Function ConvertBytesToHexString(ByVal strSource$, _ blnBytes As Boolean) As String ' Преобразование последовательности байтов в строку ' символов шестнадцатеричного кода ' ' strSource$ — исходная строка байтов ' (в вызывающей программе параметр будет неизменным, ' так как используется ByVal) ' blnBytes = True — произвольный набор байтов ' = False — символы в кодировке Unicode '============================= Dim lPos&, strChr$, strRtn$ ' strRtn = "" 'строка результатов If LenB(strSource) > 0 Then If (Not blnBytes) Then ' преобразуем Unicode в ANSI strSource = StrConv(strSource, vbFromUnicode) End If ' преобразование For lPos = 1 To LenB(strSource) strChr = Hex$(AscB(MidB(strSource, lPos, 1))) ' добавить "0", чтобы было 2 символа If Len(strChr) = 1 Then strChr = "0" & strChr strRtn = strRtn & strChr Next End If ConvertBytesToHexString = strRtn End Function
Как видите, функция позволяет работать и с произвольными байтами, и с Unicode-символами. В последнем случае (blnBytes = False) производится автоматическое преобразование из Unicode в ANSI. Следует обратить внимание на то, что такое преобразование переменной не отражается на содержимом исходной строки в вызывающей программе, поскольку используется метод передачи параметра «по значению» (ByVal).
Работа функции ConvertBytesToHexString демонстрируется на следующем тестовом примере:
Public Sub Main() ' Тестирование процедуры преобразования последовательности ' байтов в строку шестнадцатеричных символов ' Dim MySource$, MyResult$ MySource$ = "Alex Леша" ' 1. Как произвольная последовательность байтов MsgBox ConvertBytesToHexString(MySource, True) ' результат — 41006C006500780020001B04350448043004 ' 2. Как набор символов в Unicode MsgBox ConvertBytesToHexString(MySource, False) ' результат — 416C657820CBE5F8E0 ' 3. Преобразуем в ASNI и выводим как байты ' (должен получиться результат, как в п. 2) MySource = StrConv(MySource, vbFromUnicode) MsgBox ConvertBytesToHexString(MySource, True) End Sub
Сравните полученные результаты, чтобы лучше понять различие Unicode- и ANSI-кодировок. В первом случае каждый символ представлен двумя байтами (байт — двумя шестнадцатеричными символами): первый байт — собственно код символа, а второй — номер кодовой таблицы (для английской он равен 00, для русской — 04). Для английских символов коды Unicode (точнее, его первый байт) и ASNI одинаковы.
 |
|
Совет 380. Используйте автоматически запускаемые макросы Word
Word содержит несколько специальных имен для макросов, автоматически выполняемых при некоторых предопределенных событиях. Их применение позволяет создать альтернативные варианты обработки вместо встроенных функций. Приведем список этих имен с моментами их выполнения:
AutoExec — при запуске Word или загрузке глобального шаблона
AutoNew — при создании нового документа
AutoOpen — при открытии существующего документа
AutoClose — при закрытии документа
AutoExit — при закрытии Word или выгрузке глобального шаблона
Макрос будет выполняться в случаях, если он находится либо в шаблоне Normal, либо в активном документе, либо в шаблоне, на основе которого создан активный документ. Подробнее об использовании автоматически запускаемых макросов см. раздел Auto Macros справочной системы.
|
|
Совет 381. Создание строки меню
С помощью диалогового окна Customize (Настройка) можно создавать новые панели инструментов для всех приложений Office 97/2000, но новую строку меню — только в Access. Впрочем, эта задача легко решается с помощью VBA, например в среде Word:
Sub CreateNewMenuBar() ' ' программное создание строки меню Dim myMenuBar As CommandBar Set myMenuBar = CommandBars.Add(Name:="My Menu Bar", _ Position:=msoBarTop, MenuBar:=True, Temporary:=False) With myMenuBar .Visible = True .RowIndex = msoBarRowLast End With End Sub
Выполнив указанный код, мы, однако, обнаружим, что, оказывается, в этом случае новая строка меню не только создается, но и заменяет уже существующую. Точнее, ситуация выглядит следующим образом: в приложении может быть несколько строк меню, но видимым остается только одно. При этом в окне Customize видны все имеющиеся строки меню, но управлять состоянием «видимо/скрыто» (в окошке флажка) здесь нельзя, а доступна лишь операция удаления пользовательской строки меню.
Для управления выводом на экран нужной строки меню можно написать специальную макрокоманду, которая использует диалоговое окно со списком (для вызова макрокоманды лучше создать кнопку на панели инструментов или закрепить на ней комбинацию клавиш):
Sub MenuBarVisible() ' Управление состоянием строк меню UserForm1.Show ' обращение к форме End Sub Private Sub UserForm_Activate() Dim cmdb As CommandBar Dim nm As String ' формирование списка с созданными строками меню For Each cmdb In CommandBars nm = cmdb.Name ' поиск по имени If InStr(1, nm, "menu bar", 1) > 0 Then ' найдено меню ListBox1.AddItem (nm) If cmdb.Visible Then ' строка видимая ListBox1.ListIndex = ListBox1.ListCount - 1 End If End If Next End Sub Private Sub ListBox1_Click() ' видимой становится выделенная позиция списка CommandBars(ListBox1.List(ListBox1.ListIndex)).Visible = True End Sub
Следует обратить внимание на следующие моменты в приведенном здесь коде:
- Установка для некоторой строки состояния видимости автоматически скрывает остальные строки.
- К сожалению, у объекта CommandBar нет свойства, которое позволило бы определить тип объекта (меню, панель и пр.). Поэтому мы вынуждены делать поиск по контексту имени объекта (следовательно, нужно, чтобы имя содержало «Menu Bar»).
- В функции InStr используется текстовый режим поиска (при любом регистре букв). Но в этом случае почему-то обязательно следует указывать первый (необязательный) параметр вызова.
Обратившись к макрокоманде MenuBarVisible, мы получим диалоговое окно со списком строк меню (рис. 1). Выбирая элементы списка, мы будем сразу видеть на экране нужную строку меню.
Дальнейшее формирование меню может выглядеть примерно так:
Sub CreateNewMenuItem()
' формирование меню
Dim myMenu As CommandBarPopup
Dim myMenuItem1 As CommandBarPopup
Dim myMenuItem11 As CommandBarButton
Dim myMenuItem12 As CommandBarButton
Dim myMenuItem2 As CommandBarControl
' Создаем меню
Set myMenu = CommandBars("My Menu Bar").Controls.Add _
(Type:=msoControlPopup, Before:=1)
myMenu.Caption = "Новое меню"
'
' Добавляем команды к меню
'=========================
' 1. Это будет ссылка на подменю
Set myMenuItem1 = myMenu.Controls.Add _
(Type:=msoControlPopup, Before:=1)
myMenuItem1.Caption = "Ссылка на подменю"
' Формируем подменю
'1.1. Первая команда
Set myMenuItem11 = myMenuItem1.Controls.Add _
(Type:=msoControlButton, Before:=1)
myMenuItem11.Caption = "Команда 11"
myMenuItem11.OnAction = "ИмяМакрокоманды11"
'1.2. Вторая команда
Set myMenuItem12 = myMenuItem1.Controls.Add _
(Type:=msoControlButton, Before:=1)
myMenuItem12.Caption = "Команда 12"
myMenuItem12.OnAction = "ИмяМакрокоманды12"
'
' 2. Вторая стока меню — команда
Set myMenuItem2 = myMenu.Controls.Add _
(Type:=msoControlButton, Before:=1)
myMenuItem2.Caption = "Команда меню"
myMenuItem2.OnAction = "ИмяМакрокоманды2"
End Sub
В результате у нас получится меню с одной командой и ссылкой на подменю (рис. 2). В связи с этим следует иметь в виду, что описания элементов управления CommandBarPopup и CommandBarButton жестко фиксируют его тип, а CommandBarControl позволяет осуществлять динамическое определение типа.
|
|
Совет 382. Как узнать значение свойств документа Word
Свойства документа — это такие параметры, которые вы можете увидеть, открыв окно Properties (Свойства). Там находятся два набора свойств — встроенные и пользовательские. Прочитать их программным образом можно с помощью соответственно объектов BuildInDocumentProperties и CustomDocumentProperties, например следующим образом:
' Получение свойств документа Dim i%, CountOfProperties% Dim PropertyValue$ ' Встроенные On Error Resume Next ' программная обработка ошибок CountOfProperties% = ThisDocument.BuiltInDocumentProperties.Count MsgBox "Число встроенных свойств = " & CountOfProperties If CountOfProperties > 0 Then For i = 1 To CountOfProperties Debug.Print ThisDocument.BuiltInDocumentProperties(i).Name; PropertyValue = ThisDocument.BuiltInDocumentProperties(i).Value If Err.Number <> 0 Then PropertyValue = "Не определено" Debug.Print " = " & PropertyValue Err.Clear ' очистка ошибки Next End If ' Пользовательские CountOfProperties% = ThisDocument.CustomDocumentProperties.Count ' далее идет аналогичная конструкция для объекта CustomDocumentProperties
Здесь нужно обратить внимание на необходимость использования программной обработки ошибок. Дело в том, что если какие-то параметры не определены (например, дата последней печати для вновь созданного документа), то обращение к свойству Value вызывает ошибку.
Можно осуществить чтение конкретного свойства документа, в частности количества страниц, указав его индекс или имя (приведенные ниже строки идентичны):
ThisDocument.BuiltInDocumentProperties(14).Value
ThisDocument.BuiltInDocumentProperties("Number of pages").Value
Однако более правильным является использование встроенных констант VBA:
ThisDocument.BuiltInDocumentProperties(wdPropertyPages).Value
Это обусловлено тем, что в следующей версии Word, вполне возможно, изменится нумерация и даже названия свойств. Еще раз подчеркнем, что правильное чтение свойств должно выглядеть следующим образом:
On Error Resume Next ' программная обработка ошибок PropertyValue = ThisDocument.BuiltInDocumentProperties _ (PropertyName$).Value If Err.Number <> 0 Then ' Свойство не определено Err.Clear ' очистка ошибки End If
|
|
Совет 383. Копирование набора данных в XLS-файл с помощью метода CopyFromRecordset
В практике довольно часто встречается задача записи набора данных из БД в лист рабочей книги Excel. Как правило, для этого пишется программа, которая перебирает все столбцы и строки набора данных и переписывает их содержимое в соответствующие ячейки Excel. Однако гораздо проще и быстрее это можно выполнить с помощью малоизвестного метода CopyFromRecordset объекта Range. Вот пример выполнения этой операции, реализованной в виде макрокоманды Excel:
Sub CopyRecordset()
'
' Копирование набора данных в рабочую книгу
Dim db As DAO.Database
Dim rs As DAO.Recordset
' открываем набор данных
Set db = DAO.OpenDatabase("C:\vb-db\xmltest.mdb")
Set rs = db.OpenRecordset("SELECT * From Employees")
Call CopyRecordsetToWorkbook(rs) ' копирование
rs.Close ' закрываем
db.Close
Set rs = Nothing ' освобождаем
Set db = Nothing
End Sub
Sub CopyRecordsetToWorkbook(rs As DAO.Recordset)
' Копирование набор в ячейки листа
ThisWorkbook.Worksheets(1).Range("A1").CopyFromRecordset rs
End Sub
Если вы хотите сделать такое преобразование из другого приложения, написанного, например, на VB, то можно воспользоваться механизмом OLE Automation. В этом случае пригодится приведенная выше процедура CopyRecordset, а подпрограмма CopyRecordsetToWorkbook будет выглядеть так:
Sub CopyRecordsetToWorkbook(rs As DAO.Recordset)
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
'
' открываем приложение и книгу
Set xlApp = New Excel.Application
Set xlBook = xlApp.Workbooks.Open("d:\tmp\book2.xls")
' копирование
xlBook.Worksheets(1).Range("A1").CopyFromRecordset rs
'сохраняем, закрываем, очищаем
xlBook.Save
xlBook.Close False
xlApp.Quit
Set xlBook = Nothing
Set xlApp = Nothing
End Sub
Имейте в виду, что Excel 97 поддерживает работу метода CopyFromRecordset только для простых наборов данных DAO (ODBCDirect-наборы не поддерживаются), однако Excel 2000 может использовать все варианты наборов данных DAO и ADO.
|
|
Совет 384. Использование Script Control в VBA
В совете 269 мы говорили об элементе управления Script Control 1.0 (его можно скачать по адресу http://www.msdn.microsoft.com/scripting), с помощью которого можно вычислять математические выражения, заданные в виде символьной строки. Например, следующим образом:
a$ = "(2 * 5) + 3" Result = ScriptControl.Eval(a$)
Один из наших читателей обнаружил, что по какой-то причине этот элемент управления не «хочет» работать в среде VBA. Действительно, при попытке переместить его с панели инструментов на форму выдается сообщение об ошибке: «Unexpected call to method or property access».
Почему такое происходит, мы понять не смогли, но нашли альтернативное решение вопроса: можно вообще обойтись без применения элемента управления, работая напрямую с объектом. Для этого нужно посредством команды Tools|Reference подключить библиотеку Microsoft Srcipt Control 1.0 и использовать такой код, обращаясь непосредственно к объекту:
Sub MyScript()
' описание и создание объекта
' (командой Reference подключите библиотеку Microsoft Script Control)
Dim myScriptContol As MSScriptControl.ScriptControl
Set myScriptContol = New MSScriptControl.ScriptControl
' обязательно нужно определить языковой механизм
myScriptContol.Language = "vbscript"
' далее работаете с объектом
MsgBox myScriptContol.Eval("(2+5)* 6")
End Sub |
|
Совет 385. На что нужно обратить внимание при замере интервалов времени
В одной из телеконференций мы нашли вопрос об «аномальном поведении функции Timer. В документации сказано, что функция возвращает значение текущего времени суток в секундах (в виде величины типа Single), из чего со всей очевидностью следует, что она должна монотонно возрастать (но в полночь отсчет опять начнется с нуля!). Однако задавший этот вопрос обнаружил, что иногда значение переменной sngDiff в приведенном ниже фрагменте кода, может оказаться отрицательным.
Dim sngPrev As Single, sngDiff As Single sngPrev = Timer() sngDiff = Timer() - sngPrev Чтобы убедиться в этом, достаточно выполнить такой тестовый пример: Dim sngPrev As Single, sngDiff As Single Dim lngIndex As Long For lngIndex = 1 To 10000 sngPrev = Timer sngDiff = Timer - sngPrev If sngDiff < 0 Then MsgBox "Время пошло вспять = " & sngDiff End If Next
Интересно, что если написать вычисление промежутку времени как:
sngDiff = CSng(Timer) - sngPrev
то все начинает работать как следует.
В чем же здесь загвоздка? Ситуация действительно кажется странной, но только на первый взгляд. Дело в том, что функция Timer работает на уровне точности секунд и не годится для обработки тысячных долей секунды. При выводе значения Timer вы увидите число лишь с двумя знаками после запятой.
Очевидно, что при преобразовании времени из какого-то внутреннего формата происходит некоторая потеря точности. Следовательно, надо знать организацию самой функции Timer, но вполне вероятно, что она имеет собственный формат данных. Поэтому возможно, что при выполнении:
Timer - sngPrev
последняя переменная преобразуется из Single во внутренний формат Timer, и в этот момент происходит потеря точности в последнем разряде. В общем, это достаточно обычное явление, когда вы занимаетесь преобразованием форматов числовых данных на грани точности. Попробуйте выполнить такой пример:
A = 1.4
B = A
C = B + 0.2
If C < A Then MsgBox ("Ну, дела!")
Казалось бы, получение сообщения «Ну, дела!» в принципе невозможно. Однако оно будет появляться всякий раз, если вы сделаете такое определение типов данных:
Dim a As Single, c As Single, b As Integer
Это означает, что в данном случае будет происходить изменение значения числа при преобразовании его из вещественного формата в целочисленный (это мы к тому, что точный внутренний формат Timer нам не известен).
Итак, для указанных промежутков времени Timer просто не подходит. Что же делать?
В совете 193 для более точного измерения промежутков времени мы рекомендовали использовать функцию GetTickCount:
Declare Function GetTickCount& Lib "kernel32"
Она выдает время в миллисекундах с момента последнего старта или перезагрузки операционной системы (то есть обнуление счетчика будет происходить только через 49 суток непрерывной работы компьютера). Обратите внимание, что даже для наносекундных интервалов время не пойдет в обратную сторону, так как мы имеем дело с уже преобразованными целочисленными значениями.
|
|
Совет 386. Не применяйте неявного преобразования данных
Мы уже несколько раз повторяли этот совет и сейчас просто хотим привести еще одно подтверждение его правильности.
Порой в программах приходится встречать такие логические конструкции:
If Len(SomeText$) Then ' выполнение условия, если длина строки ненулевая
или:
If Err.Number Then ' Если код ошибки ненулевой
В данном случае этот код работает правильно, но потенциально угрожает надежной (прогнозируемой) работе программы. Угроза заключается в том, что после ключевого слова If должно идти логическое условие. Поэтому строгий синтаксис языка должен допускать наличие кода только следующего вида:
If Len(SomeText$) > 0 Then
Однако, к сожалению, VB позволяется использовать и такую запись:
If Len(SomeText$) Then
Эта запись на самом деле эквивалентна нижеприведенной синтаксически правильной конструкции:
Dim blnValue As Boolean blnValue = Len(SomeText$) If blnValue Then
Работоспособность этого кода определяется тем, что любое ненулевое целое число преобразуется в булево значение True и, следовательно, последующая проверка срабатывает верно. Итак, в чем же состоит опасность для надежности программы?
Предположим, что теперь мы хотим модифицировать код таким образом, чтобы некоторые действия выполнялись при пустом значении строки. Казалось бы, для этого нужно просто заменить код условия, используя логическое отрицание:
If Not Len(SomeText$) Then MsgBox "Пустое значение"
Но здесь вы обнаружите неприятную неожиданность: сообщение «Пустое значение» будет выдаваться всегда — при любом значении строковой переменной.
Действительно, приведенные ниже строки кода эквивалентны:
If Not Len("") Then
If Not 0 Then
If -1 Then
If True Then ' выполняется код
И эти строки также эквивалентны:
If Not Len("КуКу") Then
If Not 4 Then
If -5 Then
If True Then ' выполняется код
Такое происходит потому, что сначала выполняется логическая инверсия целой переменной, которая лишь потом преобразуется в логического значение.
Чтобы не мучиться с подобными проблемами, записывайте логические выражения только в явном виде. При этом и логика программы выглядит гораздо понятнее:
If Len(SomeText$) > 0 Then ...
|
|
Совет 387. Передача XML-данных в виде атрибутов
В статье «Использование XML DOM в VB и MS Office/VBA» (КомпьютерПресс № 12’2000) при передаче данных использовались тэги (элементы) языка XML. Но довольно часто удобнее бывает применять для вывода атрибуты элементов. Для сравнения двух вариантов внимательно посмотрите на код, приведенный в листинге 1.
А теперь взгляните на полученный результат (рис. 3). При всей схожести мы видим одно принципиальное различие: значения атрибутов записаны в формате международных региональных установок (независимо от установок конкретной операционной системы), а элементов — в формате национальных установок данного компьютера. Это означает, что нас ожидают определенные проблемы при передачи информации между системами с различными региональными установками.
Вот как выглядит код чтения записанного ранее XML-файла:
Public Sub XMLinput()
' Чтение XML-файла
Dim CommNode As IXMLDOMElement
Dim curNode As IXMLDOMElement
Dim subNode As IXMLDOMElement
Dim FullName$, Birthdate As Date, Height As Single
Set xmlDoc = New DOMDocument
xmlDoc.Load xmlFile$
' чтение данных
' Чтение узла "ВариантАтрибуты"
Set CommNode = xmlDoc.selectSingleNode("//ВариантАтрибуты")
For Each curNode In CommNode.selectNodes("Контакт")
FullName$ = curNode.getAttribute("Имя")
Birthdate = curNode.getAttribute("ДатаРождения")
Height = Val(curNode.getAttribute("Рост"))
MsgBox FullName & " " & Birthdate & " " & Height
Next
' Чтение узла "ВариантЭлементы"
Set CommNode = xmlDoc.selectSingleNode("//ВариантЭлементы")
For Each curNode In CommNode.selectNodes("Контакт")
FullName$ = curNode.selectSingleNode("Имя").Text
Birthdate = curNode.selectSingleNode("ДатаРождения").Text
Height = curNode.selectSingleNode("Рост").Text
MsgBox FullName & " " & Birthdate & " " & Height
Next
End Sub
В обоих случаях мы вроде бы получаем одинаково правильные результаты. Но есть один важный нюанс: первый вариант работает с международным форматом данных и поэтому не зависит от региональных установок, а второй будет работать только при условии, что региональные установки источника и приемника информации совпадают.
КомпьютерПресс 6'2001
