Советы тем, кто программирует на VB & VBA

Алексей Малинин, Ольга Павлова

Совет 397. Как использовать свойство Filter при работе с ADO

Совет 398. В который раз повторяем: используйте режим Option Explicit

Совет 399. Задавайте вопросы в понятной форме

Совет 400. Используйте режим раннего связывания

Совет 401. Управляйте режимами программного контроля ошибок

Совет 402. Быстрый поиск по списку

Совет 403. При программном создании наборов данных указывайте размеры полей

Совет 404. Программное отключение предупреждающих сообщений в приложениях MS Office

Совет 405. Как выводить на экран формы в динамическом режиме

Совет 406. Как узнать параметры диска

Совет 407. Как создать дубликатный набор данных

Совет 408. Как узнать размер свободного места на диске

Совет 409. Блокировка Windows 2000

Совет 397. Как использовать свойство Filter при работе с ADO

При работе с наборами данных ADO вы можете использовать свойство Filter, напримерследующим образом:

rst.Filter
= "pub_id ='000132' "

В этом случае будут выбраны все записи со значением 000132 в поле pub_id. Здесь важно помнить, что ADO физически не исключает из набора записи, которые не отвечают данному критерию, — просто они становятся недоступными для работы. Это, в частности, означает, что если вам нужно применить новый фильтр для работы с исходным набором, то нет необходимости производить отмену применения предыдущего фильтра — в любом случае ADO автоматически выполняет фильтрацию «исходного» набора данных.

Если же вы хотите вернуть набор данных в «неотфильтрованное» состояние, то нужно выполнить выборку с «пустым» фильтром:

rst.Filter
= adFilterNone

Совет 398. В который раз повторяем: используйте режим Option Explicit

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

Читатель Вячеслав прислал письмо с вопросом, почему у него не работает вставка таблицы из VB-проекта в Word, точнее — почему не работает конструкция:

.ActiveDocument.Tables.Add
Selection.Range, NumRows:=2, NumColumns:=2

При выполнении этой конструкции выдается сообщение об ошибке Object required. Судя по переписке (мы обменялись несколькими посланиями), на решение проблемы Вячеславу понадобилось больше недели, при этом он был уверен, что ее причина кроется в какой-то несовместимости VB и VBA. При этом он подозревал, что неадекватно ведет себя объект Range. Однако в данном случае все было гораздо проще: после переноса кода из VBA в VB Вячеслав забыл поставить точку перед Selection (этот код работал внутри конструкции With MyOblect).

Действительно, заметить такой дефект порой бывает непросто, а сообщение о необходимости объекта плохо помогает локализовать ошибку. Но если бы в программе был установлен режим Option Explicit, то появилось бы другое, более точное сообщение: «Не определена переменная Selection». К тому же ошибка была бы обнаружена не на этапе выполнения программы, а при компиляции кода. Очевидно, при такой диагностике понять причину неработоспособности кода было бы гораздо проще.

Напомним, что оператор Option Explicit будет автоматически вставляться в код нового программного модуля, если установить флажок Require Variable Declaration в окне Tools|Options|Editor (VB и VBA).

Совет  399. Задавайте вопросы в понятной форме

Именно с этого совета начиналась первая статья из серии «Размышления бывшего программиста» (КомпьютерПресс № 9’2000), но опять же приходится возвращаться к этой теме. Почему вопрос читателя, рассмотренный в предыдущем совете, решался больше недели? А потому, что его первое письмо содержало такой текст:

«Я не знаю, как средствами не VBA, а VB6 создать таблицу в MS Word. Мне казалось, что все просто: скопировать содержимое макроса в процедуру. Однако VB6 ругается на именованный параметр Range. Подскажите, как мне быть?»

Кто сможет решить проблему, изложенную таким образом? Мы попросили прислать VB-проект с примером ситуации — Вячеслав прислал одну строку кода. Еще раз попросили... Только на третий раз он прислал нужный VB-проект, содержащий 7 строк кода (включая комментарии) и занимающий 1,5 Кбайт в ZIР-файле. Запустить пример, увидеть ошибку, понять причину и отправить ответ — все это заняло две минуты.

Итак,  как нужно задать технический вопрос, если вы хотите действительно получить на него конкретный ответ:

1. Отправляйте в приложении программный проект, который эксперт может реально запустить на своем компьютере. Если речь идет о VBA, то пришлите сам документ с вложенными в него макросами. Если файлов проекта несколько или они большого объема, лучше выслать в виде архивного ZIP-файла.
2. Присылайте именно тестовый программный пример (а не проект огромного приложения), который содержит только код, позволяющий локализовать ошибку. Ничего лишнего!
3. И почитайте дополнительные рекомендации, которые можно найти по адресу www.visual.2000.ru/develop/talks/talks1_1.htm.

Совет 400. Используйте режим раннего связывания

Об этой проблеме мы говорили в статье «Особенности технологий раннего и позднего связывания в Visual Basic» (КомпьютерПресс № 9’2000). Оба режима имеют свои достоинства и недостатки, но общая рекомендация такова: если нет особой нужды применять позднее связывание (иногда это просто необходимо), то лучше использовать раннее связывание.

Вот какой код прислал нам Вячеслав:

 Dim wdApp As Object
   Set wdApp = CreateObject("word.application") 'открыть Word
     With wdApp
     .Documents.Add 'Создать новый документ
        .ActiveDocument.Tables.Add _
   Selection.Range, NumRows:=2, NumColumns:=2
End With

Здесь используется позднее связывание — конкретизация объекта wpApp происходит только в момент выполнения программы (CreateObject). Но предпочтительнее выглядит вариант с ранним связыванием:

Dim
wdApp As Word.Application
 Set
wdApp = New Word.Application
 With
wrdApp

  .Documents.Add    ' новый документ

  .ActiveDocument.SaveAs App.Path & "\RTFDOC.doc",wdFormatDocument
 
End With

В этом случае мы сразу четко фиксируем тип объекта (нужно также установить ссылку на библиотеку Word 9.0 Object Library). И в такой ситуации можно воспользоваться всеми преимуществами интеллектуальных подсказок при вводе кода.

Совет 401. Управляйте режимами программного контроля ошибок

Традиционный вариант управления программным контролем ошибок выглядит примерно так:

Sub MyProcedure
  'установка программной обработки ошибок
 On Error {GoTo MyError|Resume Next}
 ...
  'отмена программной обработки
 On Error GoTo 0
 ...
End Sub

При выходе из процедуры (End Sub или Exit Sub) отмена программной обработки ошибок выполняется автоматически, поэтому многие программисты вообще не ставят оператор On Error GoTo 0. Но тут есть один подводный камень: если вы напишете такой код:

Sub MyProcedure
  'установка программной обработки ошибок
 On Error GoTo MyError
 Call OtherProcedure
 ...
MyError:
 ' обработка 
  ...
End Sub

то в вызываемой подпрограмме OtherProcedure (и в других вложенных процедурах) будет продолжать действовать установка On Error GoTo MyError, то есть при появлении там ошибки управление будет передаваться на метку MyError. При этом нужно помнить, что если в процедуре OtherProcedure переопределить обработку ошибок, то при возврате управления в MyProcedure действие On Error GoTo MyError будет восстановлено автоматически.

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

Sub Main
  ' глобальное определение места
обработки ошибок
  ' для всего приложения
  On Error GoTo GlobalError
  Call OtherProcedure
 ...
GlobalError:
 ' обработка 
  ...
End Sub

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

Public
MyErrorPoint As String
 Sub
MyProcedure
  On Error GoTo GlobalError
  ...
  MyErrorPoint = "MySub"
  Call MySub
GlobalError:
 Select Case MyErrorPoint
   ...

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

 On Error Resume Next
 ...
 Open "TestFile" For Input As #1
 If Err.Number <> 0 Then  '
ошибка

Совет 402. Быстрый поиск по списку

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

Private
Declare Function SendMessage _
   Lib "user32" Alias "SendMessageA" _
   (ByVal hwnd As Long, ByVal wMsg As Long, _
   ByVal wParam As Long, lParam As Any) As Long
Private
sSearch As String Private Const LB_FINDSTRING = &H18F Private Const lb_Err =
(-1)
Private
Sub Form_Load()
  ' заполнение списка
  With List1
    .AddItem "Adam"
    .AddItem "Allan"
    .AddItem "Arty"
    .AddItem "Aslan"
    .AddItem "Barbey"
    .AddItem "Bob"
  End With
  Timer1.Interval = 2000  ' сброс каждые две секунды
End
Sub
Private
Sub List1_KeyPress(KeyAscii As Integer)
   ' обработка нажатых клавиш
   Dim nResult As Long
   Timer1.Enabled = True   ' запуск контроля по таймеру
   sSearch = sSearch + Chr$(KeyAscii)
   With List1 
' поиск по списку
     nResult = SendMessage(.hwnd, LB_FINDSTRING, _
              .ListIndex, ByVal sSearch)
     If nResult <> lb_Err Then ' нашли
       .ListIndex = nResult ' установка позиции
       KeyAscii = 0  ' сброс ввода клавиши
     End If
   End With
End
Sub
Private
Sub Timer1_Timer()
   ' сброс поиска каждые две секунды
   sSearch = ""
   Timer1.Enabled = False
End Sub

Здесь реализован вариант, когда на ввод отводится только две секунды. Но можно придумать и другой механизм инициализации строки поиска.

Совет 403.  При программном создании наборов данных указывайте размеры полей

Если вы попробуете выполнить такой код при программном создании набора данных ADO

Dim
rsBuild As ADODB.Recordset 
Set
rsBuild = New ADODB.Recordset 
rsBuild.CursorLocation
= adUseClient 
rsBuild.Fields.Append
"Question", adLongVarWChar 
rsBuild.Fields.Append
"AnswerA", adLongVarWChar

то, скорее всего, получите сообщение об ошибке: "Run-Time Error 3001: Method 'Append' of object 'Fields' failed". В документации VB по поводу метода Append говорится, что размер поля является необязательным параметром. Но это неверно — его нужно указывать в явном виде. Поэтому приведенный далее код будет работать без проблем:

Private
Sub Form_Load() 
Dim
rsBuild As ADODB.Recordset 
Set
rsBuild = New ADODB.Recordset 
With
rsBuild
 .CursorLocation
= adUseClient
 .Fields.Append
"Question", adLongVarWChar, 1
 .Fields.Append
"Answer", adLongVarWChar, 1
 .Open
 .AddNew
0, String(5000, "*")
 .Update
 Debug.Print
.Fields(0)
 .Close
End
With Set rsBuild = Nothing End Sub

Совет 404. Программное отключение предупреждающих сообщений в приложениях MS Office

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

Пользователи Microsoft Access знают, что такое отключение в данном приложении можно выполнить следующим образом:

DoCmd.SetWarnings = False

Этот код выключает выдачу внутренних программных сообщений. Однако объект DoCmd — это возврат к временам, когда офисные приложения имели разные внутренние языки программирования. Такого объекта в других приложениях Office нет, но есть свойство DisplayAlerts, которое решает именно эту задачу. Обратите внимание, что его поддержка выполняется в различных программах по-разному. Например, в Excel этому свойству нужно просто присвоить значение логической переменной:

Public
Sub DeleteWorksheet()
 Application.DisplayAlerts = False  
' запретить выдачу  сообщений
 ActiveWindow.SelectedSheets.Delete
 Application.DisplayAlerts = True  'разрешить
End Sub

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

Word для установки свойства DisplayAlerts использует специальные встроенные константы: wdAlertsNone, wdAlertsAll and wdAlertsMessageBox. Смысл первых двух установок понятен из их названий, а последняя означает, что Word будет выдавать только стандартные сообщения. Выполнение в этом случае кода:

ActiveDocument.Close

вызовет появление вопроса о сохранении документа. При выполнении следующего кода:

Application.DisplayAlerts
= wdAlertsNone 
ActiveDocument.Close
Application.DisplayAlerts
= wdAlertsAll

сразу же появится окно SaveAs без промежуточного вопроса.

Совет 405. Как выводить на экран формы в динамическом режиме

Допустим, вы желаете выводить на экран те или иные формы, имена которых записаны в каком-то списке. Для этого можно воспользоваться коллекцией Forms, выбор из которой нужной формы выполняется с помощью индекса или имени:

Set
frm = Forms(1)

или:

Set
frm = Forms("frmEditor")

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

Private
Sub Form_Load()
 
With List1
  .AddItem "Form1"
  .AddItem "Form2"
  .AddItem "Form3"
 End With
End
Sub
Private
Sub List1_Click() Dim frm As Form Dim selForm As String With List1
 selForm
= .List(.ListIndex)
End
With Set frm = Forms.Add(selForm) frm.Show Set frm = Nothing End Sub

Совет 406. Как узнать параметры диска

Вы хотите узнать серийный номер жесткого диска, а заодно и имя тома логического диска? Это можно сделать с помощью такого кода:

Private
Declare Function GetVolumeInformation _
  Lib "kernel32" Alias "GetVolumeInformationA" _
  (ByVal lpRootPathName As String, _
  ByVal lpVolumeNameBuffer As String, _
  ByVal nVolumeNameSize As Long, _
  lpVolumeSerialNumber As Long, _
  lpMaximumComponentLength As Long, _
  lpFileSystemFlags As Long, _
  ByVal lpFileSystemNameBuffer As String, _
  ByVal nFileSystemNameSize As Long) As Long
Private
Sub Form_Load()
   Dim sDrive As String
   Dim VolumeName As String
   Dim SerialNumber As Long
   '
   sDrive = "c:\"  'имя диска
   VolumeName = Space$(128)
   Call GetVolumeInformation(sDrive, _
      vbNullString, 128&, SerialNumber, _
      ByVal 0&, ByVal 0&, vbNullString, 0)
   VolumeName = Left$(VolumeName, InStr(VolumeName, Chr$(0)))
   MsgBox "Серийный номер
диска = " & SerialNumber & vbCrLf & _
          "Имя тома = " & VolumeName

Совет 407. Как создать дубликатный набор данных

Следует иметь в виду, что метод Clone не создает дубликат набора данных — он просто делает два разных указателя, которые работают с одним и тем же физическим набором. А выполнить формирование копии можно с помощью объекта Stream из состава ADO 2.5 (или более поздней версии):

Dim
rsOne As New ADODB.Recordset 
Dim
rsTwo As New ADODB.Recordset 
Dim
oTempStream As New ADODB.Stream 
' Далее идет
формирование набора reOne 
 ... 
rsOne.Save
oTempStream, adPersistXML  ' запоминаем 
rsTwo.Open
oTempStream            ' восстанавливаем

Совет 408. Как узнать размер свободного места на диске

Для этого можно использовать API-функцию GetDiskFreeSpaceA из библиотеки Kernel32, но она корректно работает для дисков размером до 2 Гбайт, так как была предназначена для Windows 95, где использовали FAT16. При работе с дисками больших размеров можно применить объект FileSystemObject из состава библиотеки Microsoft Scripting Runtime library (scrrun.dll), которую можно загрузить по адресу: http://www.microsoft.com/msdownload/vbscript/scripting.asp.

Вот как будет выглядеть нужный нам код:

Dim
fso As FileSystemObject 
Dim
drv As Drive
Set
fso = New FileSystemObject 
Set
drv = fso.GetDrive("C") 
MsgBox
FormatNumber(drv.AvailableSpace / 1024, 0) 
& " Кб"

Совет 409. Блокировка Windows 2000

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

Private
Declare Function LockWorkStation Lib _
 
"user32.dll" () As Long
Call LockStation

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

Call
Shell ("rundll32 user32.dll, LockWorkStation", vbNormalFocus)

Такую конструкцию можно применять и в 16-разрядных приложениях. А вот как будет выглядеть операция на VBScript:

Dim
WshShell 
Set
WshShell = CreateObject("WScript.Shell") 
WshShell.Runl
("rundll32 user32.dll, LockWorkStation)

КомпьютерПресс 10'2001