Советы тем, кто программирует на 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  

Следует обратить внимание на следующие моменты в приведенном здесь коде:

  1. Установка для некоторой строки состояния видимости автоматически скрывает остальные строки.
  2. К сожалению, у объекта CommandBar нет свойства, которое позволило бы определить тип объекта (меню, панель и пр.). Поэтому мы вынуждены делать поиск по контексту имени объекта (следовательно, нужно, чтобы имя содержало «Menu Bar»).
  3. В функции 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