Dim MyDict As New BinTree

Public Sub WorkwithBinTree() Dim MyDict As New BinTree Dim englword As String, rusword As String GlobeVar = "Привет!" 'Создание словаря
MyDict.SearchAndInsert key:="dictionary", info:="словарь" MyDict.SearchAndInsert key:="hardware", info:="аппаратура, аппаратные средства" MyDict.SearchAndInsert key:="processor", info:="процессор" MyDict.SearchAndInsert key:="backup", info:="резервная копия" MyDict.SearchAndInsert key:="token", info:="лексема" MyDict.SearchAndInsert key:="file", info:="файл" MyDict.SearchAndInsert key:="compiler", info:="компилятор" MyDict.SearchAndInsert key:="account", info:="учетная запись"
'Обход словаря MyDict.PrefixOrder
'Поиск в словаре englword = "account": rusword = "" MyDict.SearchAndInsert key:=englword, info:=rusword Debug.Print englword, rusword
'Удаление из словаря MyDict.DelInTree englword englword = "hardware" MyDict.DelInTree englword 'Обход словаря MyDict.PrefixOrder
'Debug.Print MyDict
End Sub

Пример 10.1.

Закрыть окно

Sub ProcWithErrors() ' Первый охраняемый блок On Error GoTo ErrHadler1 ' подключение 1-го обработчика ошибок ' Первая часть процедуры, которая может вызвать ошибку. ... On Error GoTo 0 отключение 1-го обработчика ошибок
'Второй охраняемый блок On Error GoTo ErrHadler2 ' подключение 2-го обработчика ошибок ' Вторая часть процедуры, которая может вызвать ошибку. ... On Error GoTo 0 отключение 2-го обработчика ошибок
'Третий охраняемый блок On Error GoTo ErrHadler3 ' подключение 3-го обработчика ошибок ' Третья часть процедуры, которая может вызвать ошибку. ... On Error GoTo 0 отключение 3-го обработчика ошибок
RepeatPoint: ' точка, с которой возобновляется выполнение 'после обработки ошибки в 3-ей части ...
Exit Sub 'выход из процедуры при отсутствии ошибок 'ОбработкаОшибок: ErrHandler1: ' 1-ый обработчик ошибок ... Resume 'возврат к оператору, вызвавшему ошибку в 1-ой части

ErrHandler2: ' 2-ой обработчик ошибок ... Resume Next 'переход к оператору, следующему за оператором 'вызвавшим ошибку во 2-ой части
ErrHandler3: ' 3-ий обработчик ошибок ... Resume RepeatPoint 'переход к строке, с которой возобновляется 'выполнение после обработки ошибки в 3-ей части End Sub

Пример 10.2.

Закрыть окно

Public Sub TestFact2() Dim Msg As String Dim VictoryCount As Integer, Prize As Long On Error GoTo ErrHandler1 VictoryCount = 5 Prize = Fact2(VictoryCount) * 5 Debug.Print VictoryCount, Prize
VictoryCount = 10 Prize = Fact2(VictoryCount) * 5 Debug.Print VictoryCount, Prize
Exit Sub ErrHandler1: Msg = "Ошибка # " & Err.Number & " возникла в " & Err.Source _ & vbCrLf & " Описание: " & Err.Description _ & vbCrLf & " HelpFile: " & Err.HelpFile _ & vbCrLf & " HelpContext: " & Err.HelpContext MsgBox Msg, vbMsgBoxHelpButton, "Error", Err.HelpFile, Err.HelpContext 'Грубое устранение причин ошибки Err.Clear If VictoryCount < 0 Then VictoryCount = 0 If VictoryCount > 7 Then VictoryCount = 7 Resume
End Sub

Пример 10.3.

Закрыть окно

Option Explicit
'Класс Day ' Свойства класса Private today As Date Private temperature As Integer
Public Property Get Сегодня() As Date Сегодня = today End Property
Public Property Let Сегодня(ByVal NewValue As Date) today = NewValue End Property
Public Property Get Температура() As Integer Температура = temperature End Property
Public Property Let Температура(ByVal NewValue As Integer) temperature = NewValue End Property
Public Sub CheckDay() Dim Desc As String Dim Numb As Long Dim Source As String 'Проверка свойств объекта Select Case Month(Сегодня) Case 6 To 8 If Температура < 0 Then 'Исключительная ситуация Desc = "Ошибка: Работа с объектом предполагает положительную летнюю температуру!" Numb = vbObjectError + 513 Source = " Метод CheckDay класса Day " Err.Raise Numb, Source, Desc End If Case 1 To 2, 12 If Температура > 0 Then 'Исключительная ситуация Desc = "Ошибка: Работа с объектом предполагает отрицательную зимнюю температуру!" Numb = vbObjectError + 514 Source = " Метод CheckDay класса Day "
Err.Raise Numb, Source, Desc End If End Select End Sub

Пример 10.4.

Закрыть окно

Public Sub WorkWithDay() 'Работа с объектами класса Day Dim myday As New Day Dim Msg As String 'Охраняемый блок On Error GoTo ErrorHandler
myday.Сегодня = "9.8.99" myday.Температура = -15 myday.CheckDay Debug.Print myday.Сегодня, myday.Температура Exit Sub ErrorHandler: If Err.Number = vbObjectError + 513 Then Msg = vbCrLf & "Введите температуру сегодняшнего дня " _ & myday.Сегодня & vbCrLf & " Учтите, она должна быть положительной" myday.Температура = InputBox(Err.Source & vbCrLf & Err.Description & Msg, "CheckDay", 15) ElseIf Err.Number = vbObjectError + 514 Then Msg = vbCrLf & "Введите температуру сегодняшнего дня " _ & myday.Сегодня & vbCrLf & " Учтите, она должна быть отрицательной" myday.Температура = InputBox(Err.Source & vbCrLf & Err.Description & Msg, "CheckDay", -15) End If Resume End Sub

Пример 10.5.

Закрыть окно

Sub Testfunc1() Dim res As Variant, arg As Variant arg = 12 res = Func1(arg) If IsError(res) Then 'проверка ошибочности результата Debug.Print "Ошибка #: ", res, "аргумент : ", arg
Else Debug.Print "Результат : ", res End If arg = "двенадцать" res = Func1(arg) If IsError(res) Then 'проверка ошибочности результата Debug.Print "Ошибка #: ", res, "аргумент : ", arg
Else Debug.Print "Результат : ", res End If End Sub

Пример 10.6.

Закрыть окно

Содержание раздела