Авторские программы, библиотеки, надстройки и шаблоны

Sub AverageTemperature1()
    Dim a As Double, b As Double, c As Double, d As Double, e As Double, result As Double
    a = -19.4: b = -24#: c = -20.9: d = -18.5: e = -16.8
    result = (a + b + c + d + e) / 5
    MsgBox "Средняя температура января: " & Format(result, "0.0")
End Sub

Option Explicit
Option Base 1 'Индексируем массивы с единицы (по умолчанию они индексируются с нуля).
 
Sub AverageTemperature2()
    Const DAYS_IN_JAN = 31 'Количество дней в январе.
    Dim i As Long, T(DAYS_IN_JAN) As Double, result As Double
    'Заполняем массив данными.
    T(1) = -19.4:   T(9) = -23.6:   T(17) = -21#:   T(25) = -15.9
    T(2) = -24#:    T(10) = -15.4:  T(18) = -16.5:  T(26) = -22.7
    T(3) = -20.9:   T(11) = -16.7:  T(19) = -18.9:  T(27) = -11.6
    T(4) = -17.5:   T(12) = -15#:   T(20) = -13.7:  T(28) = -10.2
    T(5) = -16.8:   T(13) = -14.3:  T(21) = -19.5:  T(29) = -9#
    T(6) = -23.4:   T(14) = -24.8:  T(22) = -20.2:  T(30) = -9.2
    T(7) = -23.3:   T(15) = -22.7:  T(23) = -20#:   T(31) = -7.5
    T(8) = -23#:    T(16) = -24.9:  T(24) = -23.3
    'Вычисляем сумму всех температур.
    For i = 1 To DAYS_IN_JAN
        result = result + T(i)
    Next i
    'Находим среднюю температуру.
    result = result / DAYS_IN_JAN
    'Выводим результат.
    MsgBox "Средняя температура января: " & Format(result, "0.0") & " градуса."
End Sub

Option Explicit
Option Base 1 'Индексируем массивы с единицы.
 
Sub ControlWorkRatings()
    Const PUPILS_N = 20 'Количество учащихся в классе.
    Dim i As Long, j As Long, pupil(PUPILS_N) As Long, rates(2 To 5) As Long
    'Заполняем массив данными.
    pupil(1) = 5:   pupil(8) = 3:   pupil(15) = 3
    pupil(2) = 4:   pupil(9) = 5:   pupil(16) = 5
    pupil(3) = 2:   pupil(10) = 5:  pupil(17) = 4
    pupil(4) = 3:   pupil(11) = 4:  pupil(18) = 4
    pupil(5) = 5:   pupil(12) = 2:  pupil(19) = 3
    pupil(6) = 2:   pupil(13) = 4:  pupil(20) = 4
    pupil(7) = 4:   pupil(14) = 5
    'Осуществляем перебор учащихся и подсчет оценок.
    For i = 1 To PUPILS_N
        For j = 2 To 5
            If pupil(i) = j Then 'Оценка определена...
                rates(j) = rates(j) + 1 '...увеличиваем счетчик, соответствующий оценке...
                Exit For '... и выходим из цикла.
            End If
        Next j
    Next i
    'Выводим результат.
    MsgBox "Отличных оценок получено: " & rates(5) & vbCr & _
    "Хороших оценок получено: " & rates(4) & vbCr & _
    "Удовлетворительных оценок получено: " & rates(3) & vbCr & _
    "Неудовлетворительных оценок получено: " & rates(2), , "Итоги контрольной"
End Sub

Array()

Dim retval() As Variant

Dim arr() As Variant
arr = Array(1, 2, 3)

Dim arr() As Variant
Dim retval() As Variant
ReDim retval(<Option_Base_Value> To <Option_Base_Value + 2>) As Variant
retval(<Option_Base_Value>) = 1
retval(<Option_Base_Value + 1>) = 2
retval(<Option_Base_Value + 2>) = 3
arr = retval

Sub ArrayAssign()
    Dim i As Long, s As String, A(0 To 5) As Long, B() As Long
    For i = 0 To 5: A(i) = i: Next i 'Заполнение массива A значениями.
    B = A 'Копирование значений массива A в массив B.
    For i = 0 To 5: s = s & B(i) & Space(5): Next i
    MsgBox s 'Вывод значений массива B.
End Sub

'________________________________________________________________
'______________________                    ______________________
'_____________________   Модуль AksiVector  _____________________
'____________________     Версия: 0.11.2     ____________________
'___________________       Автор: Aksima      ___________________
'___________________  Библиотека: AksiArrays  ___________________
'________________________________________________________________
'______                                                     _____
'______  Назначение: Реализует вектор - одномерный массив.  _____
'________________________________________________________________
 
Implements IFactory 'Поддерживает создание объектом класса других объектов этого же класса.
Implements ISerializable 'Поддерживает сериализацию данных.
Implements ICloneable
Enum AoSortMethod 'Перечисление методов сортировки.
    AO_BUBBLE 'Пузырковая сортировка.
    AO_SELECTION 'Сортировка путем выборки.
    AO_INSERTION 'Сортировка вставками.
End Enum
Enum AoSortOrder 'Возможные направления сортировки.
    AO_ASC = 1 'Сортировка в порядке возрастания.
    AO_DESC = -1 'Сортировка в порядке убывания.
End Enum
Dim a() As Object
Dim N As Long
'Создание объекта класса.
Private Function IFactory_NewOb() As Object
    Set IFactory_NewOb = New AksiVector
End Function
Private Function ISerializable_Serialize() As String 'Сериализация.
    Dim i As Long, s As String, z As New AksiString, src As ISerializable
    'Сериализация элемента.
    Set src = a(0)
    z = src.Serialize
    'Сериализация полученной строки.
    Set src = z
    s = src.Serialize
    For i = 1 To N - 1
        'Сериализация очередного элемента.
        Set src = a(i)
        z = src.Serialize
        'Сериализация полученной строки.
        Set src = z
        s = s & "," & src.Serialize
    Next i
    ISerializable_Serialize = s
End Function
Private Sub ISerializable_Unserialize(ByVal s As String) 'Десериализация.
    Dim i As Long, p As Long, q As Long, v As Variant, z As New AksiString
    Dim rec As ISerializable, es As Collection, ss As String, e() As String
    Set es = New Collection
    p = InStr(s, """") '(описание этой части процедуры есть в классе AksiMatrix).
    While p > 0
        ss = Trim(Left(s, p - 1))
        If Right(ss, 1) = "," Then ss = Trim(Left(ss, Len(ss) - 1))
        e = Split(ss, ",")
        For i = 0 To UBound(e)
            es.Add e(i)
        Next i
        q = InStr(p + 1, s, """")
        If q = 0 Then q = Len(s) + 1
        es.Add Mid(s, p + 1, q - p - 1)
        s = Trim(Mid(s, q + 1))
        If Left(s, 1) = "," Then s = Trim(Mid(s, 2))
        p = InStr(s, """")
    Wend
    e = Split(s, ",")
    For i = 0 To UBound(e)
        es.Add e(i)
    Next i
    For i = 0 To IIf(N < es.Count, N - 1, es.Count - 1)
        'Десериализация строки.
        Set rec = z
        rec.Unserialize es(i + 1)
        'Если в строке содержатся символы-разделители текстового файла, то
        'строка экранируется кавычками. При обратном преобразовании мы
        'проверяем наличие символов-разделителей: если они есть, то есть
        'и экранирующие кавычки. Обычно они удаляются драйвером текстового
        'файла, но здесь их необходимо удалить самостоятельно.
        If InStr(z, vbTab) + InStr(z, vbCr) + InStr(z, " ") + InStr(z, ",") > 0 _
        Then z = Mid(z, 2, Len(z.Value) - 2)
        'Десериализация элемента.
        Set rec = a(i)
        rec.Unserialize z
    Next i
End Sub
'Инициализация вектора c размерностью size и базовым объектом base.
'Базовый объект должен поддерживать интерфейс IFactory.
Public Sub Init(ByVal base As Object, ByVal size As Long)
    Dim i As Long, f As IFactory
    N = size
    Set f = base
    ReDim a(0 To N - 1) As Object
    For i = 0 To N - 1
        Set a(i) = f.NewOb
    Next i
End Sub
'Копирование содержимого вектора в новый вектор.
Private Function ICloneable_Copy() As Object
    Dim i As Long, c As ICloneable, v As New AksiVector
    v.Init a(0), N
    For i = 0 To N - 1
        Set c = a(i)
        Set v(i) = c.Copy
    Next i
    Set ICloneable_Copy = v
End Function
'Получение ссылки на элемент вектора по индексу.
Public Property Get Item(ByVal index As Long) As Object
    Set Item = a(index)
End Property
'Установка ссылки для элемента вектора с заданным индексом.
Public Property Set Item(ByVal index As Long, ByVal eNew As Object)
    If TypeName(a(index)) = TypeName(eNew) Then Set a(index) = eNew Else Err.Raise 13
End Property
'Получение количества элементов вектора.
Public Property Get Count() As Long
    Count = N
End Property
'Процедура для записи данных из вектора в текстовый файл с именем fileName.
'Базовый объект вектора должен поддерживать интерфейс ISerializable.
Public Sub PutData_TextFile(ByVal fileName As String)
    Dim i As Long, k As Long, s As String, src As ISerializable
    Dim c As AksiCatalog, f As New AksiFile
    f.Parse fileName
    If f.Path <> "\" Then
        Set src = a(0)
        s = src.Serialize
        For i = 1 To N - 1
            Set src = a(i)
            s = s & "," & src.Serialize 'Разделитель между элементами - запятая.
        Next i
        f.Catalog.MakeSureCatalogExists
        k = FreeFile
        Open fileName For Output As #k
        Print #k, s
        Close #k
    Else
        Set c = New AksiCatalog
        Set f = c.FileFind(f.Name)
        If f Is Nothing Then
            f.Name = fileName
            f.FullNameDialog "Файл " & f.Name & " не найден", "file " & f.Name & " not found"
        ElseIf f.FullName = "\" Then
            f.Name = fileName
            f.FullNameDialog "Файл " & f.Name & " не найден", "file " & f.Name & " not found"
        End If
        Set src = a(0)
        s = src.Serialize
        For i = 1 To N - 1
            Set src = a(i)
            s = s & "," & src.Serialize 'Разделитель между элементами - запятая.
        Next i
        k = FreeFile
        Open f.FullName For Output As #k
        Print #k, s
        Close #k
    End If
End Sub
'Процедура для чтения данных в вектор из текстового файла с именем fileName.
'Базовый объект вектора должен поддерживать интерфейс ISerializable.
Public Sub GetData_TextFile(ByVal fileName As String)
    Dim i As Long, k As Long, s As String
    Dim f As New AksiFile, c As AksiCatalog, rec As ISerializable
    f.Parse fileName
    If f.Path = "\" Then
        Set c = New AksiCatalog
        Set f = c.FileFind(fileName)
        If f Is Nothing Then
            f.Name = fileName
            f.FullNameDialog "Файл " & f.Name & " не найден", "file " & f.Name & " not found"
        ElseIf f.FullName = "\" Then
            f.Name = fileName
            f.FullNameDialog "Файл " & f.Name & " не найден", "file " & f.Name & " not found"
        End If
    End If
    k = FreeFile
    Open f.FullName For Input As #k
    Do Until EOF(k) 'Обрабатываем файл до конца.
        Input #k, s 'Считываем очередной элемент, разделенный запятой или знаком переноса.
        If s <> Chr(29) & Chr(30) Then 'Пропускаем разделитель слоев куба (см. класс AksiCube)
            Set rec = a(i)
            rec.Unserialize s
            i = i + 1
            If i > N - 1 Then Exit Do 'Если заполнили вектор - выходим досрочно.
        End If
    Loop
    Close #k
End Sub
'Процедура для вывода данных из вектора на диалоговое окно. Если базовый объект вектора не
'относится к одному из встроенных классов, то он должен поддерживать интерфейс ISerializable.
'Параметр title определяет заголовок диалогового окна, а floatPrecision - количество цифр,
'отображаемых в дробной части (параметр существенен только для векторов на основе AksiFloat).
Public Sub PutData_DialogBox(Optional ByVal title As String, Optional ByVal floatPrecision As Byte = 2)
    Dim i As Long, s As String, sFormat As String, src As ISerializable
    If N > 50 Then Err.Raise vbObjectError, , "Операция слишком велика (Operation too large)" & _
    vbCr & "Вы пытаетесь вывести в диалоговое окно вектор, размеры" & vbCr & _
    "которого больше допустимого лимита (50 элементов)." & vbCr & _
    "(You are trying to put into dialog box a vector with dimension" & vbCr & _
    "larger than allowed limit (maximum 50 elements)."
    Select Case TypeName(a(0))
        Case "AksiInteger"
            s = a(0)
            For i = 1 To N - 1
                s = s & Space(2) & a(i)
            Next i
        Case "AksiFloat"
            'Если в записи числа с плавающей точкой есть точка или ее аналог
            '(т.е. оно содержит дробную часть), то при выводе оно округляется
            'до точности floatPrecision во избежание громоздкости вывода.
            Select Case floatPrecision
                Case 0
                    sFormat = "0"
                Case Is <= 2
                    sFormat = "0." & String(floatPrecision, 48)
                Case Else
                    sFormat = "0.00" & String(floatPrecision - 2, 35)
            End Select
            If InStr(a(0), Format(0, ".")) Then
                If InStr(a(0), "E") Then
                    s = Format(a(0), sFormat & "E+")
                Else
                    s = Format(a(0), sFormat)
                End If
            Else
                s = a(0)
            End If
            For i = 1 To N - 1
                If InStr(a(i), Format(0, ".")) Then
                    If InStr(a(i), "E") Then
                        s = s & Space(4) & Format(a(i), sFormat & "E+")
                    Else
                        s = s & Space(4) & Format(a(i), sFormat)
                    End If
                Else
                    s = s & Space(4) & a(i)
                End If
            Next i
        Case "AksiChar"
            s = Chr(a(0))
            For i = 1 To N - 1
                s = s & Space(4) & Chr(a(i))
            Next i
        'Строки и сериализванные данные выводятся не подряд, а в столбик,
        'так как они занимают много места.
        Case "AksiString"
            s = a(0)
            For i = 1 To N - 1
                s = s & vbCr & a(i)
            Next i
        Case Else
            Set src = a(0)
            s = src.Serialize
            For i = 1 To N - 1
                Set src = a(i)
                s = s & vbCr & src.Serialize
            Next i
    End Select
    If title <> vbNullString Then MsgBox s, , title Else MsgBox s
End Sub
'Процедура для ввода данных в вектор через диалоговое окно. Если базовый объект вектора не
'относится к одному из встроенных классов, то он должен поддерживать интерфейс ISerializable.
'Параметр title определяет заголовок диалогового окна.
Public Sub GetData_DialogBox(Optional ByVal title As String)
    Dim i As Long, s As String, rec As ISerializable, v As Double, k As Long, b As Byte
    Dim f1 As Boolean, f2 As Boolean, f3 As Boolean
    Const pRU = "Пожалуйста, введите элемент № ", pEN = "(Input element number ", pE2 = ", please:"
    Const rRU = vbCr & "Пожалуйста, повторите ввод.", rEN = vbCr & "Try again, please.)"
    Const sErr = "Ошибка ввода (Invalid input)."
    If N > 50 Then Err.Raise vbObjectError, , "Операция слишком велика (Operation too large)" & _
    vbCr & "В целях сохранения здоровья оператора запрещен" & vbCr & _
    "ручной ввод векторов, размеры которых превышают" & vbCr & _
    "допустимый лимит (максимум 50 элементов)." & vbCr & _
    "(Caring of operator's health, system does not allow" & vbCr & _
    "to manually input vectors with more than 50 elements.)"
    Select Case TypeName(a(0))
        Case "AksiInteger"
            For i = 0 To N - 1
                s = pRU & i & vbCr & "- целое число." & vbCr _
                & pEN & i & pE2 & vbCr & "an integer value.)"
                If title <> vbNullString Then s = InputBox(s, title) Else s = InputBox(s)
                Do
                    f1 = False
                    f2 = False
                    f3 = False
                    'Отлов ошибки при выходе за пределы допустимого диапазона.
                    On Error Resume Next
                    v = Val(Replace(s, Format(0, "."), "."))
                    If Err Then f1 = True
                    On Error GoTo 0
                    If Not f1 Then
                        'Если функция Val вернула 0, то либо она не смогла распознать
                        'число, либо в функцию передана строка "0".
                        'Проверка ниже позволяет учесть эти факты.
                        If s = "0" Or v <> 0 Then
                            'Отлов ошибки при выходе за пределы допустимого диапазона для типа Long.
                            On Error Resume Next
                            k = CLng(v)
                            If Err Then f1 = True
                            On Error GoTo 0
                            If Not f1 Then
                                'Проверка на отсутствие дробной части.
                                If v - CDbl(k) = 0 Then
                                    a(i) = k
                                Else
                                    f2 = True
                                End If
                            End If
                        Else
                            f3 = True
                        End If
                    End If
                    If f1 Then s = "Число не должно выходить за пределы отрезка," & vbCr _
                    & "отводимого под целочисленные числа [-2^31..2^31-1]" & rRU _
                    & vbCr & "(Number must be in range between -2^31 and 2^31-1." & rEN
                    If f2 Then s = "Число должно быть целым." & rRU _
                    & vbCr & "(Number must be integer." & rEN
                    If f3 Then s = "Введенная вами строка не является" & vbCr _
                    & "корректной записью десятичного числа." & rRU _
                    & vbCr & "(System cannot recognize your input." & vbCr _
                    & "as a valid decimal number." & rEN
                    If f1 Or f2 Or f3 Then s = InputBox(s, sErr)
                Loop While f1 Or f2 Or f3
            Next i
        Case "AksiFloat"
            For i = 0 To N - 1
                s = pRU & i & vbCr & "- вещественное число." & vbCr _
                & pEN & i & pE2 & vbCr & "a real number.)"
                If title <> vbNullString Then s = InputBox(s, title) Else s = InputBox(s)
                Do
                    f1 = False
                    f2 = False
                    'Отлов ошибки при выходе за пределы допустимого диапазона.
                    On Error Resume Next
                    v = Val(Replace(s, Format(0, "."), "."))
                    If Err Then f1 = True
                    On Error GoTo 0
                    If Not f1 Then
                        'Если функция Val вернула 0, то либо она не смогла распознать
                        'число, либо в функцию передана строка "0".
                        If s = "0" Or v <> 0 Then
                            a(i) = v
                        Else
                            f2 = True
                        End If
                    End If
                    If f1 Then s = "Число не должно выходить за пределы допустимых диапазонов:" _
                    & vbCr & "-1,79E308...-5E-324; 0; 5E-324...1,79E308" & rRU _
                    & vbCr & "(Number must be in one of the following ranges:" & vbCr _
                    & "-1.79E+308...-5E-324, 0, 5E-324...1.79E+308" & rEN
                    If f2 Then s = "Введенная вами строка не является" & vbCr _
                    & "корректной записью десятичного числа." & rRU _
                    & vbCr & "(System cannot recognize your input." & vbCr _
                    & "as a valid decimal number." & rEN
                    If f1 Or f2 Then s = InputBox(s, sErr)
                Loop While f1 Or f2
            Next i
        Case "AksiChar"
            For i = 0 To N - 1
                s = pRU & i & vbCr & "- символ или его код." & vbCr _
                & pEN & i & pE2 & vbCr & "a symbol or its code.)"
                If title <> vbNullString Then s = InputBox(s, title) Else s = InputBox(s)
                Do
                    f1 = False
                    f2 = False
                    f3 = False
                    'Отлов ошибки при выходе за пределы допустимого диапазона.
                    On Error Resume Next
                    v = Val(Replace(s, Format(0, "."), "."))
                    If Err Then f1 = True
                    On Error GoTo 0
                    If Not f1 Then
                        'Проверка на успешность распознания строки в качестве числа.
                        If s = "0" Or v <> 0 Then
                            'Отлов ошибки при выходе за пределы допустимого диапазона для типа Byte.
                            On Error Resume Next
                            b = CByte(v)
                            If Err Then f1 = True
                            On Error GoTo 0
                            If Not f1 Then
                                'Проверка на отсутствие дробной части.
                                If v - CDbl(b) = 0 Then
                                    a(i) = v
                                Else
                                    f2 = True
                                End If
                            End If
                        'Если строка не была распознана как число,
                        'то проверяется ввод единственного символа.
                        ElseIf Len(s) = 1 Then
                            a(i) = Asc(s)
                        Else
                            f3 = True
                        End If
                    End If
                    If f1 Then s = "Код символа должен быть не меньше 0 и не больше 255." & rRU _
                    & vbCr & "(Code of symbol cannot be less than 0 or greater than 255." & rEN
                    If f2 Then s = "Код символа не может быть вещественным числом." & rRU _
                    & vbCr & "(Code of symbol cannot be a real number." & rEN
                    If f3 Then s = "Не допускается ввод больше одного символа." & rRU _
                    & vbCr & "(You shouldn't input more than one symbol." & rEN
                    If f1 Or f2 Or f3 Then s = InputBox(s, sErr)
                Loop While f1 Or f2 Or f3
            Next i
        Case "AksiString"
            For i = 0 To N - 1
                s = pRU & i & vbCr & "- строку." & vbCr _
                & pEN & i & pE2 & vbCr & "a string.)"
                If title <> vbNullString Then a(i) = InputBox(s, title) Else a(i) = InputBox(s)
            Next i
        Case Else
            For i = 0 To N - 1
                s = pRU & i & vbCr & "- элемент сложного типа." & vbCr _
                & pEN & i & pE2 & vbCr & "an element of non-basic data type.)"
                If title <> vbNullString Then s = InputBox(s, title) Else s = InputBox(s)
                Set rec = a(i)
                rec.Unserialize s
            Next i
    End Select
End Sub

'Процедура для записи данных из вектора в файл Excel с именем fileName. При необходимости
'уточняются индекс листа sheetIndex и параметры выбора диапазона rangeParam либо заголовок header.
'Если имя fileName не указано, то через rangeParam передается ссылка на диапазон для записи данных.
'Базовый объект вектора должен поддерживать либо свойство по умолчанию Value, либо интерфейс ISerializable.
Public Sub PutData_ExcelFile(Optional ByVal rangeParam As Variant, Optional ByVal fileName As String, _
Optional ByVal sheetIndex As Variant, Optional ByVal header As String)
 
    Dim eApp As Object, eWbk As Object, eWst As Object, eRng As Object, eCell As Object
    Dim s As String, p As String, f0 As Boolean, f1 As Boolean, f2 As Boolean, arr As Variant
    Dim i As Long, j As Long, k As Long, rr As Long, cc As Long, shCount As Long
    Dim src As ISerializable, f As New AksiFile, search As Object, t As Variant
    
    If fileName <> vbNullString Then
        f.Parse fileName
        s = f.Extension
        If Not (s = "xls" Or s = "xlsx" Or s = "xlsb" Or s = "xlsm") Then Err.Raise 75
        s = f.Name
        p = f.Path
        
        On Error GoTo ErrAppNotOpenA
        Set eApp = GetObject(, "Excel.Application")
            
        On Error GoTo ErrWbkNotOpenA
        Set eWbk = eApp.Workbooks(s)
        If eWbk.Path & "\" <> p Then Err.Raise 9
        
LblSheetSearchA:
        On Error GoTo ErrSheetNotFoundA
        If IsMissing(sheetIndex) Or IsEmpty(sheetIndex) Then sheetIndex = 1
        Set eWst = eWbk.Worksheets(sheetIndex)
        
        On Error GoTo LblTerminationA
        If IsMissing(rangeParam) Or IsEmpty(rangeParam) Then
            'Если rangeParam опущен, то по умолчанию выкладываем данные
            'в первую свободную строку листа.
            Set eRng = eWst.Range("A1")
            If IsEmpty(eRng) Then
                Set eRng = eRng.Resize(, N)
            ElseIf IsEmpty(eRng.Offset(1)) Then
                Set eRng = eRng.Offset(1).Resize(, N)
            Else
                Set eRng = eRng.End(-4121).Resize(, N)
            End If
        Else
            'Если rangeParam - логическое значение, то оно указывает
            'на наличие или отсутствие заголовка.
            If TypeName(rangeParam) = "Boolean" Then
                'True - есть заголовок, данные выкладываем в столбец снизу заголовка.
                If rangeParam Then
                    If header <> vbNullString Then
                        On Error Resume Next
                        Set search = eWst.Cells.Find(What:=header, LookIn:=xlValues, LookAt:= _
                        xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                        MatchCase:=False, SearchFormat:=True)
                        On Error GoTo LblTerminationA
                        'Если заголовок не найден, то создаем новый столбец
                        If search Is Nothing Then 'с требуемым заголовком.
                            Set eRng = eWst.Range("A1")
                            If Not IsEmpty(eRng) Then
                                If IsEmpty(eRng.Offset(, 1)) Then
                                    Set eRng = eRng.Offset(, 1)
                                Else
                                    Set eRng = eRng.End(-4161).Offset(, 1)
                                End If
                            End If
                            eRng.Font.Bold = True
                            eRng = header
                            Set eRng = eRng.Offset(1).Resize(N)
                        Else 'Если нашли заголовок...
                            Set eRng = search.Offset(1)
                            'При необходимости очищаем его от старых данных.
                            If Not IsEmpty(eRng) Then
                                If IsEmpty(eRng.Offset(1)) Then
                                    eRng.ClearContents
                                Else
                                    eWst.Range(eRng, eRng.End(-4121)).ClearContents
                                End If
                            End If
                            Set eRng = eRng.Resize(N) 'И потом заносим новые.
                        End If
                    Else 'Если заголовое нужен, но его текст не задан...
                        'Находим подходящий столбец.
                        Set eRng = eWst.Range("A1")
                        If Not IsEmpty(eRng) Then
                            If IsEmpty(eRng.Offset(, 1)) Then
                                Set eRng = eRng.Offset(, 1)
                            Else
                                Set eRng = eRng.End(-4161).Offset(, 1)
                            End If
                        End If
                        eRng.Font.Bold = True
                        'Просматриваем все существующие заголовки и выбираем
                        'подходящее (неповторяющееся) название для нового столбца.
                        If eRng.Column > 1 Then
                            arr = eWst.Range(eWst.Range("A1"), eRng.Offset(, -1)).Value
                            k = UBound(arr, 2)
                            Do
                                j = 0
                                For i = 1 To k - 1
                                    If arr(1, i) > arr(1, i + 1) Then
                                        t = arr(1, i)
                                        arr(1, i) = arr(1, i + 1)
                                        arr(1, i + 1) = t
                                        j = j + 1
                                    End If
                                Next i
                            Loop While j > 0
                            s = "Column0"
                            j = 0
                            For i = 1 To k - 1
                                If arr(1, i) = s Then
                                    j = j + 1
                                    s = "Column" & j
                                End If
                            Next i
                            eRng = s
                        Else 'Если нет других заголовков, то "Column0" - заголовок по умолчанию.
                            eRng = "Column0"
                        End If
                        Set eRng = eRng.Offset(1).Resize(N)
                    End If
                'False - заголовка нет, данные выкладываем в первую свободную строку листа.
                Else
                    Set eRng = eWst.Range("A1")
                    If IsEmpty(eRng) Then
                        Set eRng = eRng.Resize(, N)
                    ElseIf IsEmpty(eRng.Offset(1)) Then
                        Set eRng = eRng.Offset(1).Resize(, N)
                    Else
                        Set eRng = eRng.End(-4121).Resize(, N)
                    End If
                End If
            'Если rangeParam - строка, то это должен быть адрес диапазона.
            ElseIf TypeName(rangeParam) = "String" Then
                Set eRng = eWst.Range(rangeParam)
            Else
                Err.Raise 5
            End If
        End If
    Else
        Set eRng = rangeParam
    End If
    
    On Error Resume Next 'Проверка на поддержку свойства Value.
    t = a(0).Value
    f2 = Err.Number = 438
    
    On Error GoTo LblTerminationA
    'Если искомый диапазон - непрерывный, то заполняем массив в памяти и выкладываем
    'его на лист одним движением, иначе поочередно заполняем ячейки диапазона.
    If eRng.Areas.Count = 1 Then
        i = 0
        k = 0
        rr = eRng.Rows.Count
        cc = eRng.Columns.Count
        If f2 Then 'Выбираем способ заполнения в зависимости от поддержки свойства Value.
            ReDim arrS(0 To rr - 1, 0 To cc - 1) As String
            Do While i <= rr - 1
                For j = 0 To cc - 1
                    k = i * cc + j
                    If k = N Then Exit Do
                    Set src = a(k)
                    arrS(i, j) = src.Serialize
                Next j
                i = i + 1
            Loop
            eRng = arrS
        Else
            ReDim arrV(0 To rr - 1, 0 To cc - 1) As Variant
            Do While i <= rr - 1
                For j = 0 To cc - 1
                    k = i * cc + j
                    If k = N Then Exit Do
                    arrV(i, j) = a(k)
                Next j
                i = i + 1
            Loop
            eRng = arrV
        End If
    Else
        If f2 Then 'Выбираем способ заполнения в зависимости от поддержки свойства Value.
            For Each eCell In eRng.Cells
                Set src = a(k)
                eCell = src.Serialize
                k = k + 1
            Next eCell
        Else
            For Each eCell In eRng.Cells
                eCell = a(k)
                k = k + 1
            Next eCell
        End If
    End If
    On Error GoTo 0
    If f1 Then eWbk.Close True
    If f0 Then eApp.Quit
    Exit Sub
 
ErrAppNotOpenA:
    If Err.Number = 429 Then 'Приложение Excel не открыто.
        f0 = True
        Set eApp = CreateObject("Excel.Application")
        Resume Next
    Else
        GoTo LblTerminationA
    End If
 
ErrWbkNotOpenA:
    If Err.Number = 9 Then 'Искомая книга не открыта в текущем приложении Excel.
        f1 = True
        Resume LblCreateWorkbookA
    Else
        GoTo LblTerminationA
    End If
 
LblCreateWorkbookA:
    On Error GoTo ErrWbkNotExistsA
    Set eWbk = eApp.Workbooks.Open(fileName)
    GoTo LblSheetSearchA
 
ErrWbkNotExistsA:
    If Err.Number = 1004 Then 'Искомая книга вообще не существует.
        Set eWbk = eApp.Workbooks.Add
        f.Catalog.MakeSureCatalogExists
        eWbk.SaveAs fileName
        Resume Next
    Else
        GoTo LblTerminationA
    End If
 
ErrSheetNotFoundA:
    If Err.Number = 9 Then 'Искомый лист не найден в книге.
        If TypeName(sheetIndex) = "Byte" Or TypeName(sheetIndex) = "Integer" Or TypeName(sheetIndex) = "Long" Then
            If sheetIndex > 0 And sheetIndex <= 100 Then
                shCount = eWbk.Sheets.Count
                eWbk.Sheets.Add After:=eWbk.Sheets(shCount), Count:=sheetIndex - shCount
                Resume
            Else
                Err.Raise 9
            End If
        ElseIf TypeName(sheetIndex) = "String" Then
            eWbk.Sheets.Add.Name = sheetIndex
            Resume
        Else
            Err.Raise 5
        End If
    Else
        GoTo LblTerminationA
    End If
    
LblTerminationA: 'Аварийное завершение программы с освобождением использованных ресурсов.
    If f1 Then
        eWbk.Close False
        Set eWbk = Nothing
    End If
    If f0 Then
        eApp.Quit
        Set eApp = Nothing
    End If
    Err.Raise Err.Number, Err.Source, Err.Description, Err.HelpFile, Err.HelpContext
End Sub
'Процедура для чтения данных в вектор из файла Excel с именем fileName, листа sheetIndex и
'диапазона с адресом rangeParam или диапазона с заголовком header. Если имя fileName
'не указано, то через rangeParam передается ссылка на диапазон, из которого читаются данные.
'Базовый объект вектора должен поддерживать либо свойство по умолчанию Value, либо интерфейс ISerializable.
Public Sub GetData_ExcelFile(Optional ByVal rangeParam As Variant, Optional ByVal fileName As String, _
Optional ByVal sheetIndex As Variant, Optional ByVal header As String)
 
    Dim eApp As Object, eWbk As Object, eWst As Object, eRng As Object, eCell As Object
    Dim f0 As Boolean, f1 As Boolean, f2 As Boolean, t As Variant, arr As Variant
    Dim i As Long, j As Long, k As Long, rr As Long, cc As Long, f As New AksiFile
    Dim s As String, p As String, src As ISerializable, search As Object
    If fileName <> vbNullString Then
        f.Parse fileName
        s = f.Name
        p = f.Path
        
        On Error GoTo ErrAppNotOpenB
        Set eApp = GetObject(, "Excel.Application")
            
        On Error GoTo ErrWbkNotOpenB
        Set eWbk = eApp.Workbooks(s)
        If eWbk.Path & "\" <> p Then Err.Raise 9
        
        On Error GoTo LblTerminationB
        If IsMissing(sheetIndex) Or IsEmpty(sheetIndex) Then
            Set eWst = eWbk.Worksheets(1)
        Else
            Set eWst = eWbk.Worksheets(sheetIndex)
        End If
        If IsMissing(rangeParam) Or IsEmpty(rangeParam) Or (TypeName(rangeParam) = "Boolean" And rangeParam = True) Then
            If header <> vbNullString Then 'Если задан текст заголовка...
                On Error Resume Next 'То ищем заголовок.
                Set search = eWst.Cells.Find(What:=header, LookIn:=xlValues, LookAt:= _
                xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                MatchCase:=False, SearchFormat:=True)
                On Error GoTo LblTerminationB
                If search Is Nothing Then 'Если заголовок не найден - перерываем работу.
                    Err.Raise 9
                Else 'Иначе находим и обрабатываем данные снизу заголока (если они есть).
                    Set eRng = search.Offset(1)
                    If IsEmpty(eRng) Then Exit Sub _
                    Else If Not IsEmpty(eRng.Offset(1)) _
                    Then Set eRng = eWst.Range(eRng, eRng.End(-4121))
                End If
            Else
                Err.Raise 5
            End If
        ElseIf TypeName(rangeParam) = "Boolean" And rangeParam = False Then
            Err.Raise 5
        Else
            Set eRng = eWst.Range(rangeParam)
        End If
    Else
        Set eRng = rangeParam
    End If
    
    On Error Resume Next 'Проверка на поддержку свойства Value.
    a(0).Value = t
    f2 = Err.Number = 438
    
    On Error GoTo LblTerminationB
    'Если искомый диапазон - непрерывный, то снимаем его с листа в массив
    'и обрабатываем данные в массиве, иначе поочередно обрабатываем ячейки диапазона.
    If eRng.Areas.Count = 1 Then
        arr = eRng
        rr = UBound(arr)
        cc = UBound(arr, 2)
        i = 1
        If f2 Then 'Выбираем способ заполнения в зависимости от поддержки свойства Value.
            Do While i <= rr
                For j = 1 To cc
                    k = (i - 1) * cc + j - 1
                    If k = N Then Exit Do
                    Set src = a(k)
                    src.Unserialize arr(i, j)
                Next j
                i = i + 1
            Loop
        Else
            Do While i <= rr
                For j = 1 To cc
                    k = (i - 1) * cc + j - 1
                    If k = N Then Exit Do
                    a(k) = arr(i, j)
                Next j
                i = i + 1
            Loop
        End If
    Else
        If f2 Then 'Выбираем способ заполнения в зависимости от поддержки свойства Value.
            For Each eCell In eRng.Cells
                Set src = a(k)
                src.Unserialize eCell.Value
                k = k + 1
            Next eCell
        Else
            For Each eCell In eRng.Cells
                a(k) = eCell.Value
                k = k + 1
            Next eCell
        End If
    End If
    On Error GoTo 0
    If f1 Then eWbk.Close False
    If f0 Then eApp.Quit
    Exit Sub
 
ErrAppNotOpenB:
    If Err.Number = 429 Then 'Приложение Excel не открыто.
        f0 = True
        Set eApp = CreateObject("Excel.Application")
        Resume Next
    Else
        GoTo LblTerminationB
    End If
 
ErrWbkNotOpenB:
    If Err.Number = 9 Then 'Искомая книга не открыта в текущем приложении Excel.
        f1 = True
        Set eWbk = eApp.Workbooks.Open(fileName)
        Resume Next
    Else
        GoTo LblTerminationB
    End If
    
LblTerminationB: 'Аварийное завершение программы с освобождением использованных ресурсов.
    If f1 Then
        eWbk.Close False
        Set eWbk = Nothing
    End If
    If f0 Then
        eApp.Quit
        Set eApp = Nothing
    End If
    Err.Raise Err.Number, Err.Source, Err.Description, Err.HelpFile, Err.HelpContext
End Sub
'Преобразование времени в секундах в часы, минуты (от 0 до 59) и секунды (от 0 до 59).
Private Sub SecsToHMS(ByVal secs As Long, ByRef hms() As Integer)
    hms(2) = secs Mod 60
    secs = secs \ 60
    hms(1) = secs Mod 60
    hms(0) = secs \ 60
End Sub
'Функция, выполняющая корректное сложение дат, представленных в разных форматах.
Private Function SumDates(ByVal d1 As Date, ByVal d2 As Date) As Date
    Dim d1p(0 To 5) As Integer, d2p(0 To 5) As Integer
    Dim i As Long, k As Long, arr As Variant
    arr = Array("yyyy", "m", "d", "h", "n", "s")
    For i = 0 To 5
        d1p(i) = DatePart(arr(i), d1)
        d2p(i) = DatePart(arr(i), d2)
    Next i
    k = 4 * (CLng((d1p(0) = 1899) And (d1p(1) = 12) And (d1p(2) = 30)) + _
    2 * CLng((d1p(3) = 0) And (d1p(4) = 0) And (d1p(5) = 0))) + _
    CLng((d2p(0) = 1899) And (d2p(1) = 12) And (d2p(2) = 30)) + _
    2 * CLng((d2p(3) = 0) And (d2p(4) = 0) And (d2p(5) = 0))
    Select Case k
        Case 0
            For i = 0 To 5
                d1 = DateAdd(arr(i), d2p(i), d1)
            Next i
        Case -1, -9
            For i = 3 To 5
                d1 = DateAdd(arr(i), d2p(i), d1)
            Next i
        Case -2, -10
            For i = 0 To 2
                d1 = DateAdd(arr(i), d2p(i), d1)
            Next i
        Case -4, -5, -6
            For i = 3 To 5
                d2 = DateAdd(arr(i), d1p(i), d2)
            Next i
        Case -8, -10
            For i = 0 To 2
                d2 = DateAdd(arr(i), d1p(i), d2)
            Next i
    End Select
    Select Case k
        Case 0, -1, -2, -3, -7, -9, -10, -11
            SumDates = d1
        Case -4, -5, -6, -8, -12, -13, -14, -15
            SumDates = d2
    End Select
End Function

'Процедура для заполения вектора данными, сгенерированными с помощью генератора случайных чисел.
'Данные генерируются в диапазоне от low_val (включительно) до high_val (включительно), либо в
'диапазоне, определенном по умолчанию. Параметр seed определяет число, используемое для
'генерации последовательности (псевдо)случайных чисел, а параметр floatPrecision - точность,
'до которой округляются вещественные числа (если параметр floatPrecision не задан, вещественные
'числа не округляются). В качестве данных генератор умеет генерировать числа, символы и даты.
Public Sub GetData_RandomGenerator(Optional ByVal low_val, Optional ByVal high_val, _
Optional ByVal seed, Optional ByVal floatPrecision)
    Dim i As Long, s As Long, d As Date, t As Date, multiplier As Long, arr As Variant
    Dim d1p(0 To 5) As Integer, d2p(0 To 5) As Integer, dp(0 To 2) As Integer
    Dim d1f As Long, d2f As Long, dif As Long, k As Long
    If IsMissing(seed) Then Randomize Else Randomize Val(seed) 'Инициализируем генератор.
    If IsMissing(low_val) Then 'Используем границы по умолчанию.
        If IsMissing(high_val) Then
            Select Case TypeName(a(0))
                Case "AksiInteger"
                    For i = 0 To N - 1
                        a(i) = Int(100 * Rnd)
                    Next i
                Case "AksiFloat"
                    If IsMissing(floatPrecision) Then
                        For i = 0 To N - 1
                            a(i) = 100 * Rnd - 50
                        Next i
                    Else
                        If IsNumeric(floatPrecision) Then
                            floatPrecision = CByte(Val(floatPrecision))
                            If floatPrecision = 0 Then
                                For i = 0 To N - 1
                                    a(i) = Int(101 * Rnd - 50)
                                Next i
                            Else
                                multiplier = 10 ^ floatPrecision
                                For i = 0 To N - 1
                                    a(i) = Int(2 * (Rnd - 0.5) * multiplier) / multiplier
                                Next i
                            End If
                        Else
                            Err.Raise 13
                        End If
                    End If
                Case "AksiChar"
                    For i = 0 To N - 1
                        a(i) = Int(256 * Rnd)
                    Next i
                Case "AksiDate"
                        high_val = Now
                        low_val = DateAdd("yyyy", -1, high_val)
                        arr = Array("yyyy", "m", "d", "h", "n", "s")
                        For i = 3 To 5
                            d1p(i) = DatePart(arr(i), low_val)
                        Next i
                        dif = DateDiff("d", low_val, high_val)
                        For i = 0 To N - 1
                            d = DateAdd("d", Int((dif + 1) * Rnd), low_val)
                            SecsToHMS Int(86400 * Rnd), dp
                            a(i) = SumDates(d, TimeSerial(dp(0), dp(1), dp(2)))
                        Next i
                Case Else
                    Err.Raise 5
            End Select
        Else
            Err.Raise 5
        End If
    Else 'Используем границы, заданные пользователем.
        If IsMissing(high_val) Then
            Err.Raise 5
        Else
            Select Case TypeName(a(0))
                Case "AksiInteger"
                    If IsNumeric(low_val) And IsNumeric(high_val) Then
                        low_val = Val(low_val)
                        high_val = Val(high_val)
                        If low_val - CLng(low_val) = 0 And high_val - CLng(high_val) = 0 Then
                            If low_val > high_val Then
                                Err.Raise 5, , "Неверные аргументы - нижняя граница больше верхней" & _
                                vbCr & "(Invalid argument(s) - low_val is greater than high_val)."
                            Else
                                For i = 0 To N - 1
                                    a(i) = Int((high_val - low_val + 1) * Rnd + low_val)
                                Next i
                            End If
                        Else
                            Err.Raise 5, , "Неверные аргументы - границы должны быть целыми" & _
                            vbCr & "(Invalid argument(s) - bounds must be integers)."
                        End If
                    Else
                        Err.Raise 13
                    End If
                Case "AksiFloat"
                    If IsNumeric(low_val) And IsNumeric(high_val) Then
                        low_val = Val(low_val)
                        high_val = Val(high_val)
                        If low_val > high_val Then
                            Err.Raise 5, , "Неверные аргументы - нижняя граница больше верхней" & _
                            vbCr & "(Invalid argument(s) - low_val is greater than high_val)."
                        Else
                            If IsMissing(floatPrecision) Then
                                For i = 0 To N - 1
                                    a(i) = (high_val - low_val) * Rnd + low_val
                                Next i
                            Else
                                If IsNumeric(floatPrecision) Then
                                    floatPrecision = CByte(Val(floatPrecision))
                                    multiplier = 10 ^ floatPrecision
                                    For i = 0 To N - 1
                                        a(i) = (Int((high_val - low_val) * Rnd + low_val) * multiplier) / multiplier
                                    Next i
                                Else
                                    Err.Raise 13
                                End If
                            End If
                        End If
                    Else
                        Err.Raise 13
                    End If
                Case "AksiChar"
                    If TypeName(low_val) = "String" And TypeName(high_val) = "String" Then
                        If Len(low_val) = 1 And Len(high_val) = 1 Then
                            low_val = Asc(low_val)
                            high_val = Asc(high_val)
                            If low_val > high_val Then
                                Err.Raise 5, , "Неверные аргументы - нижняя граница больше верхней" & _
                                vbCr & "(Invalid argument(s) - low_val is greater than high_val)."
                            Else
                                For i = 0 To N - 1
                                    a(i) = Int((high_val - low_val + 1) * Rnd + low_val)
                                Next i
                            End If
                        Else
                            Err.Raise 5, , "Неверные аргументы - границы представляются 1 символом." & _
                            vbCr & "(Invalid argument(s) - bounds must be 1-char symbols)."
                        End If
                    Else
                        low_val = CByte(Val(low_val))
                        high_val = CByte(Val(high_val))
                        If low_val > high_val Then
                            Err.Raise 5, , "Неверные аргументы - нижняя граница больше верхней" & _
                            vbCr & "(Invalid argument(s) - low_val is greater than high_val)."
                        Else
                            For i = 0 To N - 1
                                a(i) = Int((high_val - low_val + 1) * Rnd + low_val)
                            Next i
                        End If
                    End If
                Case "AksiDate"
                    If IsDate(low_val) And IsDate(high_val) Then
                        low_val = CDate(low_val)
                        high_val = CDate(high_val)
                        'Разбиваем обе даты на составляющие.
                        arr = Array("yyyy", "m", "d", "h", "n", "s")
                        For i = 0 To 5
                            d1p(i) = DatePart(arr(i), low_val)
                            d2p(i) = DatePart(arr(i), high_val)
                        Next i
                        'Получаем числа, характеризующие формат дат.
                        d1f = CLng((d1p(0) = 1899) And (d1p(1) = 12) And (d1p(2) = 30)) + _
                            2 * CLng((d1p(3) = 0) And (d1p(4) = 0) And (d1p(5) = 0))
                        d2f = CLng((d2p(0) = 1899) And (d2p(1) = 12) And (d2p(2) = 30)) + _
                            2 * CLng((d2p(3) = 0) And (d2p(4) = 0) And (d2p(5) = 0))
                        k = 4 * d1f + d2f
                        Select Case k 'Анализируем их формат.
                            Case 0, -2, -8 'Если одна из дат в полном формате, то...
                                If low_val > high_val Then
                                    Err.Raise 5, , "Неверные аргументы - нижняя граница больше верхней" & _
                                    vbCr & "(Invalid argument(s) - low_val is greater than high_val)."
                                Else
                                    '1) если они определяют один и тот же день, то генерируем только время.
                                    If d1p(0) = d2p(0) And d1p(1) = d2p(1) And d1p(2) = d2p(2) Then
                                        s = 3600& * d1p(3) + 60& * d1p(4) + d1p(5)
                                        dif = 3600& * d2p(3) + 60& * d2p(4) + d2p(5) - s
                                        For i = 0 To N - 1
                                            SecsToHMS Int((dif + 1) * Rnd + s), dp
                                            a(i) = SumDates(DateSerial(d1p(0), d1p(1), d1p(2)), _
                                            TimeSerial(dp(0), dp(1), dp(2)))
                                        Next i
                                    Else '2) если они определяют разные дни, генерируем сначала дату, потом время.
                                        dif = DateDiff("d", low_val, high_val)
                                        For i = 0 To N - 1
                                            d = DateAdd("d", Int((dif + 1) * Rnd), low_val)
                                            'Если сгенерированная дата приходится на тот же день,
                                            'что указан в нижней границе, то генерируем время, начиная от
                                            'указанного в нижней границе, и до 23:59:59.
                                            If d = DateSerial(d1p(0), d1p(1), d1p(2)) Then
                                                s = 3600& * d1p(3) + 60& * d1p(4) + d1p(5)
                                                SecsToHMS Int((86400 - s) * Rnd + s), dp
                                                a(i) = SumDates(d, TimeSerial(dp(0), dp(1), dp(2)))
                                            'Иначе, если сгенерированная дата приходится на тот же день,
                                            'что указан в верхней границе, то генерируем время, начиная от
                                            '0:00:00, и до указанного в верхней границе.
                                            ElseIf d = DateSerial(d2p(0), d2p(1), d2p(2)) Then
                                                s = 3600& * d2p(3) + 60& * d2p(4) + d2p(5)
                                                SecsToHMS Int((s + 1) * Rnd), dp
                                                a(i) = SumDates(d, TimeSerial(dp(0), dp(1), dp(2)))
                                            'В остальных случаях генерируем время от 0:00:00 до 23:59:59.
                                            Else
                                                SecsToHMS Int(86400 * Rnd), dp
                                                a(i) = SumDates(d, TimeSerial(dp(0), dp(1), dp(2)))
                                            End If
                                        Next i
                                    End If
                                End If
                            Case -1, -4, -5, -9, -12, -13 'Если одна из дат или обе в формате времени, то...
                                'Сверяем только время.
                                If TimeSerial(d1p(3), d1p(4), d1p(5)) > TimeSerial(d2p(3), d2p(4), d2p(5)) Then
                                    Err.Raise 5, , "Неверные аргументы - нижняя граница больше верхней" & _
                                    vbCr & "(Invalid argument(s) - low_val is greater than high_val)."
                                Else
                                    s = 3600& * d1p(3) + 60& * d1p(4) + d1p(5)
                                    dif = 3600& * d2p(3) + 60& * d2p(4) + d2p(5) - s
                                    Select Case k
                                        Case -1
                                            d = DateSerial(d1p(0), d1p(1), d1p(2))
                                        Case -4
                                            d = DateSerial(d2p(0), d2p(1), d2p(2))
                                        Case -5
                                            d = #12:00:00 AM#
                                        Case -9
                                            d = low_val
                                        Case -12
                                            d = DateSerial(d2p(0), d2p(1), d2p(2))
                                        Case -13
                                            d = #12:00:00 AM#
                                    End Select
                                    For i = 0 To N - 1
                                        SecsToHMS Int((dif + 1) * Rnd + s), dp
                                        t = TimeSerial(dp(0), dp(1), dp(2))
                                        a(i) = SumDates(d, TimeSerial(dp(0), dp(1), dp(2)))
                                    Next i
                                End If
                            Case -3, -6, -7, -11
                                Err.Raise 5, , "Неверные аргументы - нижняя граница больше верхней" & _
                                vbCr & "(Invalid argument(s) - low_val is greater than high_val)."
                            Case -10 'Если обе даты указаны в формате без времени.
                                If low_val > high_val Then
                                    Err.Raise 5, , "Неверные аргументы - нижняя граница больше верхней" & _
                                    vbCr & "(Invalid argument(s) - low_val is greater than high_val)."
                                Else
                                    dif = DateDiff("d", low_val, high_val)
                                    For i = 0 To N - 1
                                        a(i) = DateAdd("d", Int((dif + 1) * Rnd), low_val)
                                    Next i
                                End If
                            Case -14
                                For i = 0 To N - 1
                                    a(i) = high_val
                                Next i
                            Case -15
                                For i = 0 To N - 1
                                    a(i) = #12:00:00 AM#
                                Next i
                        End Select
                    Else
                        Err.Raise 13
                    End If
                Case Else
                    Err.Raise 5
            End Select
        End If
    End If
End Sub
'Процедура пузырковой сортировки. Параметр direction определяет
'порядок сортировки (восходящая или нисходящая). Параметр cmp -
'- объект, определяющий способ сравнения сортируемых объектов.
'При отсутствии объекта применяется интерфейс IComparable.
Private Sub BubbleSort(ByVal direction As AoSortOrder, Optional ByVal cmp As IComparer)
    Dim oneToCompare As IComparable
    Dim one As Object, another As Object
    Dim i As Long, j As Long, p As Long, t As Object
    If cmp Is Nothing Then
        For i = 1 To N - 1 'i определяет количество "всплывших" элементов.
            p = 0 'Счетчик перестановок.
            For j = 0 To N - i - 1 'Просматриваем все элементы, кроме "всплывших".
                Set oneToCompare = a(j)
                Set another = a(j + 1)
                'Если текущий элемент больше следующего (или меньше - в зависимости
                'от значения direction), то выполняем перестановку элементов.
                If oneToCompare.CompareTo(another) = direction Then
                    Set t = a(j)
                    Set a(j) = a(j + 1)
                    Set a(j + 1) = t
                    p = p + 1 'Увеличиваем счетчик перестановок.
                End If
            Next j
            If p = 0 Then Exit For 'Если не было произведено ни одной перестановки,
            'значит, последовательность уже отсортирована. Выходим из цикла.
        Next i
    Else 'То же, что и выше, но сравнение производится с помощью объекта cmp.
        For i = 1 To N - 1
            p = 0
            For j = 0 To N - i - 1
                Set one = a(j)
                Set another = a(j + 1)
                If cmp.Compare(one, another) = direction Then
                    Set t = a(j)
                    Set a(j) = a(j + 1)
                    Set a(j + 1) = t
                    p = p + 1
                End If
            Next j
            If p = 0 Then Exit For
        Next i
    End If
End Sub
'Процедура сортировки выборками. Параметр direction определяет
'порядок сортировки (восходящая или нисходящая). Параметр cmp -
'- объект, определяющий способ сравнения сортируемых объектов.
'При отсутствии объекта применяется интерфейс IComparable.
Private Sub SelectionSort(ByVal direction As AoSortOrder, Optional ByVal cmp As IComparer)
    Dim oneToCompare As IComparable
    Dim one As Object, another As Object
    Dim i As Long, j As Long, p As Long, t As Object
    If cmp Is Nothing Then
        For i = N - 1 To 1 Step -1 'i определяет индекс элемента для обмена.
            Set oneToCompare = a(0)
            p = 0
            For j = 1 To i 'Просматриваем все элементы вектора до обмениваемого.
                Set another = a(j)
                'Если текущий элемент больше выбранного (или меньше - в зависимости
                'от значения direction), то берем его как максимум (минимум).
                If oneToCompare.CompareTo(another) = direction Then
                    Set oneToCompare = another
                    p = j
                End If
            Next j
            If p <> i Then
                Set t = a(i)
                Set a(i) = a(p)
                Set a(p) = t
            End If
        Next i
    Else 'То же, что и выше, но сравнение производится с помощью объекта cmp.
        For i = N - 1 To 1
            Set oneToCompare = a(0)
            p = 0
            For j = 1 To i
                Set another = a(j)
                If cmp.Compare(one, another) = direction Then
                    Set oneToCompare = another
                    p = j
                End If
            Next j
            If p <> i Then
                Set t = a(i)
                Set a(i) = a(p)
                Set a(p) = t
            End If
        Next i
    End If
End Sub

'Процедура сортировки вставками. Параметр direction определяет
'порядок сортировки (восходящая или нисходящая). Параметр cmp -
'- объект, определяющий способ сравнения сортируемых объектов.
'При отсутствии объекта применяется интерфейс IComparable.
Private Sub InsertionSort(ByVal direction As AoSortOrder, Optional ByVal cmp As IComparer)
    Dim oneToCompare As IComparable
    Dim one As Object, another As Object
    Dim i As Long, j As Long, f As Boolean, c As New Collection
    c.Add a(0)
    If cmp Is Nothing Then
        For i = 1 To N - 1 'i определяет индекс вставляемого элемента.
            Set another = a(i)
            f = True
            'Ищем элемент, перед которым следует производить вставку.
            For j = 1 To c.Count
                Set oneToCompare = c(j)
                If oneToCompare.CompareTo(another) = direction Then
                    c.Add Item:=a(i), Before:=j
                    f = False
                    Exit For
                End If
            Next j
            'Если не нашли элемента, перед которым следует производить вставку, то
            'просто добавляем элемент в конец коллекции.
            If f Then c.Add a(i)
        Next i
        For i = 0 To N - 1
            Set a(i) = c(i + 1)
        Next i
    Else 'То же, что и выше, но сравнение производится с помощью объекта cmp.
        For i = 1 To N - 1
            Set another = a(i)
            f = True
            For j = 1 To c.Count
                Set one = c(j)
                If cmp.Compare(one, another) = direction Then
                    c.Add Item:=a(i), Before:=j
                    f = False
                    Exit For
                End If
            Next j
            If f Then c.Add a(i)
        Next i
        For i = 0 To N - 1
            Set a(i) = c(i + 1)
        Next i
    End If
End Sub
'Процедура сортировки элементов вектора. Параметр method определяет алгоритм, применяемый
'при сортировке, параметр direction определяет порядок сортировки (восходящая или нисходящая).
'Параметр cmp - объект, определяющий способ сравнения сортируемых объектов. Если он
'не используется, то применяется способ сравения, встроенный в базовый элемент вектора
'(для этого базовый элемент должен поддерживать интерфейс IComparable).
Public Sub Sort(Optional ByVal method As AoSortMethod = AO_BUBBLE, _
Optional ByVal direction As AoSortOrder = AO_ASC, Optional ByVal cmp As IComparer)
    Select Case method
        Case AO_BUBBLE
            BubbleSort direction, cmp
        Case AO_SELECTION
            SelectionSort direction, cmp
        Case AO_INSERTION
            InsertionSort direction, cmp
        Case Else
            Err.Raise 5
    End Select
End Sub
'Процедура группировки и подсчета элементов вектора целых чисел.
Public Function CountUnique() As AksiMatrix
    Dim i As Long, k As Long, c As IComparable, v As AksiVector, m As AksiMatrix
    Select Case TypeName(a(0))
        Case "AksiInteger", "AksiChar", "AksiString"
            Set v = ICloneable_Copy
            v.Sort
            Set c = v(0)
            k = 1
            For i = 1 To N - 1
                If c.CompareTo(v(i)) Then
                    Set c = v(i)
                    k = k + 1
                End If
            Next i
            Set m = New AksiMatrix
            m.Init New AksiInteger, k, 2
            Set c = v(0)
            k = 0
            m(0, 0).Value = v(0).Value
            m(0, 1) = 1
            For i = 1 To N - 1
                If c.CompareTo(v(i)) Then
                    Set c = v(i)
                    k = k + 1
                    m(k, 0).Value = v(i).Value
                    m(k, 1) = 1
                Else
                    m(k, 1) = m(k, 1) + 1
                End If
            Next i
            Set CountUnique = m
        Case Else
            Err.Raise 5
    End Select
End Function
'Функция для получения максимального элемента вектора.
Public Function Max(Optional ByVal cmp As IComparer) As Object
    Dim i As Long, o As Object, c As IComparable
    Set o = a(0)
    If cmp Is Nothing Then
        Set c = a(0)
        For i = 1 To N - 1
            If c.CompareTo(a(i)) = -1 Then
                Set c = a(i)
                Set o = a(i)
            End If
        Next i
    Else
        For i = 1 To N - 1
            If cmp.Compare(o, a(i)) = -1 Then Set o = a(i)
        Next i
    End If
    Set Max = o
End Function
'Функция для получения минимального элемента вектора.
Public Function Min(Optional ByVal cmp As IComparer) As Object
    Dim i As Long, o As Object, c As IComparable
    Set o = a(0)
    If cmp Is Nothing Then
        Set c = a(0)
        For i = 1 To N - 1
            If c.CompareTo(a(i)) = 1 Then
                Set c = a(i)
                Set o = a(i)
            End If
        Next i
    Else
        For i = 1 To N - 1
            If cmp.Compare(o, a(i)) = 1 Then Set o = a(i)
        Next i
    End If
    Set Min = o
End Function
'Сумма элементов числового вектора.
Public Property Get Sum() As Object
    Dim i As Long, o As IMath
    Set o = a(0)
    Set Sum = a(0)
    For i = 1 To N - 1
        Set Sum = o.©(Sum, a(i))
    Next i
End Property
'Произведение элементов числового вектора.
Public Property Get Product() As Object
    Dim i As Long, o As IMath
    Set o = a(0)
    Set Product = a(0)
    For i = 1 To N - 1
        Set Product = o.·(Product, a(i))
    Next i
End Property
'Среднее арифметческое элементов числового вектора.
Public Property Get Average() As Object
    Dim i As Long, c As IConvertible, o As IMath
    If TypeOf a(0) Is AksiInteger Then Set o = New AksiFloat Else Set o = a(0)
    Set c = a(0)
    Set Average = o.®(Sum, c.Convert(N))
End Property
'Вызов функции для каждого элемента вектора.
Public Function GroupOperation(ByVal oper As String, opType As VbCallType, returnOb As Object) As AksiVector
    Dim i As Long, v As New AksiVector
    v.Init returnOb, N
    For i = 0 To N - 1
        v(i) = CallByName(a(i), oper, opType)
    Next i
    Set GroupOperation = v
End Function

'________________________________________________________________
'______________________                    ______________________
'_____________________   Модуль AksiMatrix  _____________________
'____________________      Версия: 0.9.0     ____________________
'___________________       Автор: Aksima      ___________________
'___________________  Библиотека: AksiArrays  ___________________
'________________________________________________________________
'_____                                                      _____
'_____  Назначение: Реализует матрицу - двухмерный массив.  _____
'________________________________________________________________
 
Enum AoMatrixReadOrder 'Порядок чтения элементов матрицы.
    AO_BYROWS 'Матрица считывается по строкам.
    AO_BYCOLS 'Матрица считывается по столбцам.
End Enum
Enum AoMatrixParts 'Перечисление частей матрицы.
    AO_WHOLE        'Вся матрица.
    AO_ROWS         'Строки матрицы.
    AO_COLUMNS      'Столбцы матрицы.
    AO_MAIN_DIAG    'Главная диагональ матрицы.
    AO_SIDE_DIAG    'Побочная диагональ матрицы.
    AO_UP_MAIN_EXC      'Элементы выше главной диагонали.
    AO_DOWN_MAIN_EXC    'Элементы ниже главной диагонали.
    AO_UP_SIDE_EXC      'Элементы выше побочной диагонали.
    AO_DOWN_SIDE_EXC    'Элементы ниже побочной диагонали.
    AO_UP_MAIN_INC      'Главная диагональ и элементы выше ее.
    AO_DOWN_MAIN_INC    'Главная диагональ и элементы ниже ее.
    AO_UP_SIDE_INC      'Побочная диагональ и элементы выше ее.
    AO_DOWN_SIDE_INC    'Побочная диагональ и элементы ниже ее.
End Enum
Dim a() As Object
Dim r As Long, c As Long
'Инициализация матрицы с размерностями rowSize, colSize и базовым объектом base.
'Базовый объект должен поддерживать интерфейс IFactory.
Public Sub Init(ByVal base As Object, ByVal rowSize As Long, ByVal colSize As Long)
    Dim i As Long, j As Long, f As IFactory
    r = rowSize
    c = colSize
    Set f = base
    ReDim a(0 To r - 1, 0 To c - 1) As Object
    For i = 0 To r - 1
        For j = 0 To c - 1
            Set a(i, j) = f.NewOb
        Next j
    Next i
End Sub
'Получение ссылки на элемент матрицы по индексам.
Public Property Get Item(ByVal rowIndex As Long, ByVal colIndex As Long) As Object
    Set Item = a(rowIndex, colIndex)
End Property
'Установка ссылки для элемента матрицы с заданными индексами.
Public Property Set Item(ByVal rowIndex As Long, ByVal colIndex As Long, ByVal eNew As Object)
    If TypeName(a(rowIndex, colIndex)) = TypeName(eNew) Then Set a(rowIndex, colIndex) = eNew Else Err.Raise 13
End Property
'Получение общего количества элементов в матрице.
Public Property Get Count() As Long
    Count = r * c
End Property
'Получение количества строк матрицы.
Public Property Get CountRow() As Long
    CountRow = r
End Property
'Получение количества столбцов матрицы.
Public Property Get CountCol() As Long
    CountCol = c
End Property
'Процедура для записи данных из матрицы в текстовый файл с именем fileName.
'Базовый объект матрицы должен поддерживать интерфейс ISerializable.
Public Sub PutData_TextFile(ByVal fileName As String)
    Dim i As Long, j As Long, N As Long, s As String
    Dim t As AksiCatalog, f As New AksiFile, src As ISerializable
    f.Parse fileName
    If f.Path <> "\" Then
        Set src = a(0, 0)
        s = src.Serialize
        For j = 1 To c - 1
            Set src = a(0, j)
            s = s & "," & src.Serialize
        Next j
        For i = 1 To r - 1
            Set src = a(i, 0)
            s = s & vbCrLf & src.Serialize
            For j = 1 To c - 1
                Set src = a(i, j)
                s = s & "," & src.Serialize
            Next j
        Next i
        f.Catalog.MakeSureCatalogExists
        N = FreeFile
        Open fileName For Output As #N
        Print #N, s
        Close #N
    Else
        Set t = New AksiCatalog
        Set f = t.FileFind(f.Name)
        If f Is Nothing Then
            f.Name = fileName
            f.FullNameDialog "Файл " & f.Name & " не найден", "file " & f.Name & " not found"
        ElseIf f.FullName = "\" Then
            f.Name = fileName
            f.FullNameDialog "Файл " & f.Name & " не найден", "file " & f.Name & " not found"
        End If
        Set src = a(0, 0)
        s = src.Serialize
        For j = 1 To c - 1
            Set src = a(0, j)
            s = s & "," & src.Serialize
        Next j
        For i = 1 To r - 1
            Set src = a(i, 0)
            s = s & vbCrLf & src.Serialize
            For j = 1 To c - 1
                Set src = a(i, j)
                s = s & "," & src.Serialize
            Next j
        Next i
        N = FreeFile
        Open f.FullName For Output As #N
        Print #N, s
        Close #N
    End If
End Sub
'Процедура для чтения данных в матрицу из текстового файла с именем fileName.
'Базовый объект матрицы должен поддерживать интерфейс ISerializable.
Public Sub GetData_TextFile(ByVal fileName As String)
    Dim i As Long, j As Long, N As Long, p As Long, q As Long
    Dim s As String, ss As String, e() As String, es As Collection
    Dim f As New AksiFile, t As AksiCatalog, rec As ISerializable
    f.Parse fileName
    If f.Path = "\" Then
        Set t = New AksiCatalog
        Set f = t.FileFind(fileName)
        If f Is Nothing Then
            f.Name = fileName
            f.FullNameDialog "Файл " & f.Name & " не найден", "file " & f.Name & " not found"
        ElseIf f.FullName = "\" Then
            f.Name = fileName
            f.FullNameDialog "Файл " & f.Name & " не найден", "file " & f.Name & " not found"
        End If
    End If
    N = FreeFile
    Open f.FullName For Input As #N
    Set es = New Collection
    Do Until EOF(N) 'Обрабатываем файл до конца.
        Line Input #N, s 'Считываем строку из файла.
        If s <> Chr(29) & Chr(30) Then 'Пропускаем разделитель слоев куба (см. класс AksiCube)
            Set es = New Collection
            'Прежде чем разлагать строку по запятым, выделяем участки, ограниченные
            'парой кавычек, так как запятые внутри кавычек не должны учитываться.
            p = InStr(s, """")
            While p > 0 'Для каждого найденного участка...
                ss = Trim(Left(s, p - 1)) 'Получаем строку слева от первой кавычки.
                'Убираем из полученной строки смежную с первой кавычкой запятую.
                If Right(ss, 1) = "," Then ss = Trim(Left(ss, Len(ss) - 1))
                e = Split(ss, ",") 'Разлагаем строку по запятым.
                For j = 0 To UBound(e)
                    es.Add e(j)
                Next j
                q = InStr(p + 1, s, """") 'Ищем вторую кавычку.
                If q = 0 Then q = Len(s) + 1
                es.Add Mid(s, p + 1, q - p - 1)
                s = Trim(Mid(s, q + 1))
                'Убираем смежную со второй кавычкой запятую.
                If Left(s, 1) = "," Then s = Trim(Mid(s, 2))
                'Анализируем строку после второй кавычки.
                p = InStr(s, """")
            Wend
            e = Split(s, ",") 'Разлагаем всю остальную строку по запятым.
            For j = 0 To UBound(e)
                es.Add e(j)
            Next j
            For j = 0 To IIf(c < es.Count, c - 1, es.Count - 1)
                Set rec = a(i, j)
                rec.Unserialize es(j + 1)
            Next j
            i = i + 1
            If i > r - 1 Then Exit Do 'Если заполнили матрицу - выходим досрочно.
        End If
    Loop
    Close #N
End Sub
'Процедура для вывода целых чисел как есть, чисел в экспоненциальном формате -
'- без дробной части, а остальных - с двумя знаками после запятой.
Private Function CutAfterDecimal(ByVal x As Double) As String
    If InStr(x, Format(0, ".")) Then
        If InStr(x, "E") Then
            CutAfterDecimal = Format(x, "0E+")
        Else
            CutAfterDecimal = Format(x, "0.00")
        End If
    Else
        CutAfterDecimal = x
    End If
End Function
'Процедура для вывода данных из матрицы на диалоговое окно. Ввиду ограничений
'на размер диалогового окна, вывод поддерживается только для матриц на основе
'классов AksiInteger, AksiFloat или AksiChar, либо матриц, элементы которых
'выражаются строками длиной не более восьми элементов.
Public Sub PutData_DialogBox(Optional ByVal title As String)
    Dim i As Long, j As Long, s As String, t As String, src As ISerializable
    If r > 12 Or c > 8 Then Err.Raise vbObjectError, , "Операция слишком велика (Operation too large)" & _
    vbCr & "Вы пытаетесь вывести в диалоговое окно матрицу, количество" & vbCr & _
    "строк или столбцов которой больше допустимого лимита." & vbCr & _
    "Допускается вывод не более 12 строк и 8 столбцов." & vbCr & _
    "(You are trying to put into dialog box a matrix with dimensions" & vbCr & _
    "larger than allowed limit (maximum 12 rows and 8 columns)."
    Select Case TypeName(a(0, 0))
        Case "AksiInteger"
            s = a(0, 0)
            For j = 1 To c - 1
                s = s & vbTab & a(0, j)
            Next j
            For i = 1 To r - 1
                s = s & vbCrLf & a(i, 0)
                For j = 1 To c - 1
                    s = s & vbTab & a(i, j)
                Next j
            Next i
        Case "AksiFloat"
            s = CutAfterDecimal(a(0, 0))
            For j = 1 To c - 1
                s = s & vbTab & CutAfterDecimal(a(0, j))
            Next j
            For i = 1 To r - 1
                s = s & vbCrLf & CutAfterDecimal(a(i, 0))
                For j = 1 To c - 1
                    s = s & vbTab & CutAfterDecimal(a(i, j))
                Next j
            Next i
        Case "AksiChar"
            s = Chr(a(0, 0))
            For j = 1 To c - 1
                s = s & vbTab & Chr(a(0, j))
            Next j
            For i = 1 To r - 1
                s = s & vbCrLf & Chr(a(i, 0))
                For j = 1 To c - 1
                    s = s & vbTab & Chr(a(i, j))
                Next j
            Next i
        Case "AksiString"
            If Len(a(0, 0)) > 8 Then GoTo ErrTooLargeString Else s = a(0, 0)
            For j = 1 To c - 1
                If Len(a(0, j)) > 8 Then GoTo ErrTooLargeString Else s = s & vbTab & a(0, j)
            Next j
            For i = 1 To r - 1
                If Len(a(i, 0)) > 8 Then GoTo ErrTooLargeString Else s = s & vbCrLf & a(i, 0)
                For j = 1 To c - 1
                    If Len(a(i, j)) > 8 Then GoTo ErrTooLargeString Else s = s & vbTab & a(i, j)
                Next j
            Next i
        Case Else
            Set src = a(0, 0)
            t = src.Serialize
            If Len(t) > 8 Then GoTo ErrTooLargeString Else s = t
            For j = 1 To c - 1
                Set src = a(0, j)
                t = src.Serialize
                If Len(t) > 8 Then GoTo ErrTooLargeString Else s = s & vbTab & t
            Next j
            For i = 1 To r - 1
                Set src = a(i, 0)
                t = src.Serialize
                If Len(t) > 8 Then GoTo ErrTooLargeString Else s = s & vbCrLf & t
                For j = 1 To c - 1
                    Set src = a(i, j)
                    t = src.Serialize
                    If Len(t) > 8 Then GoTo ErrTooLargeString Else s = s & vbTab & t
                Next j
            Next i
    End Select
    If title <> vbNullString Then MsgBox s, , title Else MsgBox s
    Exit Sub
 
ErrTooLargeString:
    Err.Raise vbObjectError, , "Операция слишком велика (Operation too large)" & _
    vbCr & "Вы пытаетесь вывести в диалоговое окно матрицу, элементы" & vbCr & _
    "которой не помещаются в пространстве, выделенном для" & vbCr & _
    "диалогового окна." & vbCr & _
    "(You are trying to put into dialog box a matrix with elements" & vbCr & _
    "which cannot be displayed in dialog box reserved space."
End Sub

'Процедура для ввода данных в матрицу через диалоговое окно. Если базовый объект матрицы не
'относится к одному из встроенных классов, то он должен поддерживать интерфейс ISerializable.
'Параметр title определяет заголовок диалогового окна, letter - букву для обозначения массива.
Public Sub GetData_DialogBox(Optional ByVal title As String, Optional ByVal letter As String = "m")
    Dim i As Long, j As Long, s As String, rec As ISerializable, v As Double, k As Long, b As Byte
    Dim f1 As Boolean, f2 As Boolean, f3 As Boolean, pRU As String, pEN As String
    Const pR2 = ") матрицы", pE2 = "), please:"
    Const rRU = vbCr & "Пожалуйста, повторите ввод.", rEN = vbCr & "Try again, please.)"
    Const sErr = "Ошибка ввода (Invalid input)."
    pRU = "Пожалуйста, введите элемент " & letter & "("
    pEN = "(Input matrix element " & letter & "("
    If r > 8 Or c > 8 Then Err.Raise vbObjectError, , "Операция слишком велика (Operation too large)" & _
    vbCr & "В целях сохранения здоровья оператора запрещен" & vbCr & _
    "ручной ввод матриц, размеры которых превышают" & vbCr & _
    "допустимый лимит (максимум 8 строк/столбцов)." & vbCr & _
    "(Caring of operator's health, system does not allow" & vbCr & _
    "to manually input matrices with more than 8 rows/columns.)"
    Select Case TypeName(a(0, 0))
        Case "AksiInteger"
            For i = 0 To r - 1
                For j = 0 To c - 1
                    s = pRU & i & "," & j & pR2 & vbCr & "- целое число." & vbCr _
                    & pEN & i & "," & j & pE2 & vbCr & "an integer value.)"
                    If title <> vbNullString Then s = InputBox(s, title) Else s = InputBox(s)
                    Do
                        f1 = False
                        f2 = False
                        f3 = False
                        On Error Resume Next
                        v = Val(Replace(s, Format(0, "."), "."))
                        If Err Then f1 = True
                        On Error GoTo 0
                        If Not f1 Then
                            If s = "0" Or v <> 0 Then
                                On Error Resume Next
                                k = CLng(v)
                                If Err Then f1 = True
                                On Error GoTo 0
                                If Not f1 Then
                                    If v - CDbl(k) = 0 Then
                                        a(i, j) = k
                                    Else
                                        f2 = True
                                    End If
                                End If
                            Else
                                f3 = True
                            End If
                        End If
                        If f1 Then s = "Число не должно выходить за пределы отрезка," & vbCr _
                        & "отводимого под целочисленные числа [-2^31..2^31-1]" & rRU _
                        & vbCr & "(Number must be in range between -2^31 and 2^31-1." & rEN
                        If f2 Then s = "Число должно быть целым." & rRU _
                        & vbCr & "(Number must be integer." & rEN
                        If f3 Then s = "Введенная вами строка не является" & vbCr _
                        & "корректной записью десятичного числа." & rRU _
                        & vbCr & "(System cannot recognize your input." & vbCr _
                        & "as a valid decimal number." & rEN
                        If f1 Or f2 Or f3 Then s = InputBox(s, sErr)
                    Loop While f1 Or f2 Or f3
                Next j
            Next i
        Case "AksiFloat"
            For i = 0 To r - 1
                For j = 0 To c - 1
                    s = pRU & i & "," & j & pR2 & vbCr & "- вещественное число." & vbCr _
                    & pEN & i & "," & j & pE2 & vbCr & "a real number.)"
                    If title <> vbNullString Then s = InputBox(s, title) Else s = InputBox(s)
                    Do
                        f1 = False
                        f2 = False
                        On Error Resume Next
                        v = Val(Replace(s, Format(0, "."), "."))
                        If Err Then f1 = True
                        On Error GoTo 0
                        If Not f1 Then
                            If s = "0" Or v <> 0 Then
                                a(i, j) = v
                            Else
                                f2 = True
                            End If
                        End If
                        If f1 Then s = "Число не должно выходить за пределы допустимых диапазонов:" _
                        & vbCr & "-1,79E308...-5E-324; 0; 5E-324...1,79E308" & rRU _
                        & vbCr & "(Number must be in one of the following ranges:" & vbCr _
                        & "-1.79E+308...-5E-324, 0, 5E-324...1.79E+308" & rEN
                        If f2 Then s = "Введенная вами строка не является" & vbCr _
                        & "корректной записью десятичного числа." & rRU _
                        & vbCr & "(System cannot recognize your input." & vbCr _
                        & "as a valid decimal number." & rEN
                        If f1 Or f2 Then s = InputBox(s, sErr)
                    Loop While f1 Or f2
                Next j
            Next i
        Case "AksiChar"
            For i = 0 To r - 1
                For j = 0 To c - 1
                    s = pRU & i & "," & j & pR2 & vbCr & "- символ или его код." & vbCr _
                    & pEN & i & "," & j & pE2 & vbCr & "a symbol or its code.)"
                    If title <> vbNullString Then s = InputBox(s, title) Else s = InputBox(s)
                    Do
                        f1 = False
                        f2 = False
                        f3 = False
                        On Error Resume Next
                        v = Val(Replace(s, Format(0, "."), "."))
                        If Err Then f1 = True
                        On Error GoTo 0
                        If Not f1 Then
                            If s = "0" Or v <> 0 Then
                                On Error Resume Next
                                b = CByte(v)
                                If Err Then f1 = True
                                On Error GoTo 0
                                If Not f1 Then
                                    If v - CDbl(b) = 0 Then
                                        a(i, j) = v
                                    Else
                                        f2 = True
                                    End If
                                End If
                            ElseIf Len(s) = 1 Then
                                a(i, j) = Asc(s)
                            Else
                                f3 = True
                            End If
                        End If
                        If f1 Then s = "Код символа должен быть не меньше 0 и не больше 255." & rRU _
                        & vbCr & "(Code of symbol cannot be less than 0 or greater than 255." & rEN
                        If f2 Then s = "Код символа не может быть вещественным числом." & rRU _
                        & vbCr & "(Code of symbol cannot be a real number." & rEN
                        If f3 Then s = "Не допускается ввод больше одного символа." & rRU _
                        & vbCr & "(You shouldn't input more than one symbol." & rEN
                        If f1 Or f2 Or f3 Then s = InputBox(s, sErr)
                    Loop While f1 Or f2 Or f3
                Next j
            Next i
        Case "AksiString"
            For i = 0 To r - 1
                For j = 0 To c - 1
                    s = pRU & i & "," & j & pR2 & vbCr & "- строку." & vbCr _
                    & pEN & i & "," & j & pE2 & vbCr & "a string.)"
                    If title <> vbNullString Then a(i, j) = InputBox(s, title) Else a(i, j) = InputBox(s)
                Next j
            Next i
        Case Else
            For i = 0 To r - 1
                For j = 0 To c - 1
                    s = pRU & i & vbCr & "- элемент сложного типа." & vbCr _
                    & pEN & i & pE2 & vbCr & "an element of non-basic data type.)"
                    If title <> vbNullString Then s = InputBox(s, title) Else s = InputBox(s)
                    Set rec = a(i, j)
                    rec.Unserialize s
                Next j
            Next i
    End Select
End Sub
'Процедура для записи данных из матрицы в файл Excel с именем fileName.
'При необходимости уточняется индекс листа sheetIndex и параметры выбора диапазона rangeParam.
'Если имя fileName не указано, то через rangeParam передается ссылка на диапазон для записи данных.
'Базовый объект матрицы должен поддерживать либо свойство по умолчанию Value, либо интерфейс ISerializable.
Public Sub PutData_ExcelFile(Optional ByVal rangeParam As Variant, Optional ByVal fileName As String, _
Optional ByVal sheetIndex As Variant)
 
    Dim eApp As Object, eWbk As Object, eWst As Object, eRng As Object
    Dim s As String, p As String, f0 As Boolean, f1 As Boolean, f2 As Boolean
    Dim i As Long, j As Long, rr As Long, cc As Long, shCount As Long
    Dim arr As Variant, t As Variant, src As ISerializable, f As New AksiFile
    
    If fileName <> vbNullString Then
        f.Parse fileName
        s = f.Extension
        If Not (s = "xls" Or s = "xlsx" Or s = "xlsb" Or s = "xlsm") Then Err.Raise 75
        s = f.Name
        p = f.Path
        
        On Error GoTo ErrAppNotOpenA
        Set eApp = GetObject(, "Excel.Application")
            
        On Error GoTo ErrWbkNotOpenA
        Set eWbk = eApp.Workbooks(s)
        If eWbk.Path & "\" <> p Then Err.Raise 9
        
LblSheetSearchA:
        On Error GoTo ErrSheetNotFoundA
        If IsMissing(sheetIndex) Or IsEmpty(sheetIndex) Then sheetIndex = 1
        Set eWst = eWbk.Worksheets(sheetIndex)
        
        On Error GoTo LblTerminationA
        If IsMissing(rangeParam) Or IsEmpty(rangeParam) Then
            'Если rangeParam опущен, то по умолчанию выкладываем данные
            'в прямоугольный диапазон, начинающийся с ячейки A1.
            Set eRng = eWst.Range("A1").Resize(r, c)
        Else
            'Если rangeParam - строка, то она указывает адрес диапазона.
            If TypeName(rangeParam) = "String" Then
                Set eRng = eWst.Range(rangeParam)
            Else
                Err.Raise 5
            End If
        End If
    Else
        Set eRng = rangeParam
    End If
    
    On Error Resume Next 'Проверка на поддержку свойства Value.
    t = a(0).Value
    f2 = Err.Number = 438
    
    On Error GoTo LblTerminationA
    Set eRng = eRng.Areas(1)
    rr = eRng.Rows.Count
    cc = eRng.Columns.Count
    If r < rr Then rr = r
    If c < cc Then cc = c
    If f2 Then 'Выбираем способ заполнения в зависимости от поддержки свойства Value.
        ReDim arrS(0 To rr - 1, 0 To cc - 1) As String
        For i = 0 To rr - 1
            For j = 0 To cc - 1
                Set src = a(i, j)
                arrS(i, j) = src.Serialize
            Next j
        Next i
        eRng = arrS
    Else
        ReDim arrV(0 To rr - 1, 0 To cc - 1) As Variant
        For i = 0 To rr - 1
            For j = 0 To cc - 1
                arrV(i, j) = a(i, j)
            Next j
        Next i
        eRng = arrV
    End If
    On Error GoTo 0
    If f1 Then eWbk.Close True
    If f0 Then eApp.Quit
    Exit Sub
 
ErrAppNotOpenA:
    If Err.Number = 429 Then 'Приложение Excel не открыто.
        f0 = True
        Set eApp = CreateObject("Excel.Application")
        Resume Next
    Else
        GoTo LblTerminationA
    End If
 
ErrWbkNotOpenA:
    If Err.Number = 9 Then 'Искомая книга не открыта в текущем приложении Excel.
        f1 = True
        Resume LblCreateWorkbookA
    Else
        GoTo LblTerminationA
    End If
 
LblCreateWorkbookA:
    On Error GoTo ErrWbkNotExistsA
    Set eWbk = eApp.Workbooks.Open(fileName)
    GoTo LblSheetSearchA
 
ErrWbkNotExistsA:
    If Err.Number = 1004 Then 'Искомая книга вообще не существует.
        Set eWbk = eApp.Workbooks.Add
        f.Catalog.MakeSureCatalogExists
        eWbk.SaveAs fileName
        Resume Next
    Else
        GoTo LblTerminationA
    End If
 
ErrSheetNotFoundA:
    If Err.Number = 9 Then 'Искомый лист не найден в книге.
        If TypeName(sheetIndex) = "Byte" Or TypeName(sheetIndex) = "Integer" Or TypeName(sheetIndex) = "Long" Then
            If sheetIndex > 0 And sheetIndex <= 100 Then
                shCount = eWbk.Sheets.Count
                eWbk.Sheets.Add After:=eWbk.Sheets(shCount), Count:=sheetIndex - shCount
                Resume
            Else
                Err.Raise 9
            End If
        ElseIf TypeName(sheetIndex) = "String" Then
            eWbk.Sheets.Add.Name = sheetIndex
            Resume
        Else
            Err.Raise 5
        End If
    Else
        GoTo LblTerminationA
    End If
    
LblTerminationA: 'Аварийное завершение программы с освобождением использованных ресурсов.
    If f1 Then
        eWbk.Close False
        Set eWbk = Nothing
    End If
    If f0 Then
        eApp.Quit
        Set eApp = Nothing
    End If
    Err.Raise Err.Number, Err.Source, Err.Description, Err.HelpFile, Err.HelpContext
End Sub
'Процедура для чтения данных в матрицу из файла Excel с именем fileName, листа sheetIndex и
'диапазона с адресом rangeParam. Если имя fileName не указано, то через rangeParam передается
'ссылка на диапазон, из которого читаются данные. Базовый объект вектора должен поддерживать
'либо свойство по умолчанию Value, либо интерфейс ISerializable.
Public Sub GetData_ExcelFile(Optional ByVal rangeParam As Variant, Optional ByVal fileName As String, _
Optional ByVal sheetIndex As Variant)
 
    Dim eApp As Object, eWbk As Object, eWst As Object, eRng As Object, src As ISerializable
    Dim f0 As Boolean, f1 As Boolean, f2 As Boolean, arr As Variant, f As New AksiFile
    Dim i As Long, j As Long, rr As Long, cc As Long, s As String, p As String, t As Variant
 
    If fileName <> vbNullString Then
        f.Parse fileName
        s = f.Name
        p = f.Path
        
        On Error GoTo ErrAppNotOpenB
        Set eApp = GetObject(, "Excel.Application")
            
        On Error GoTo ErrWbkNotOpenB
        Set eWbk = eApp.Workbooks(s)
        If eWbk.Path & "\" <> p Then Err.Raise 9
        
        On Error GoTo LblTerminationB
        If IsMissing(sheetIndex) Or IsEmpty(sheetIndex) Then
            Set eWst = eWbk.Worksheets(1)
        Else
            Set eWst = eWbk.Worksheets(sheetIndex)
        End If
        If IsMissing(rangeParam) Or IsEmpty(rangeParam) Then
            'Если rangeParam опущен, то по умолчанию предполагается, что
            'данные находятся в прямоугольном диапазоне, начинающемся с ячейки A1.
            Set eRng = eWst.Range("A1")
            Set eRng = Application.Intersect(eRng.Resize(r, c), eRng.CurrentRegion)
        Else
            Set eRng = eWst.Range(rangeParam)
        End If
    Else
        Set eRng = rangeParam
    End If
    
    On Error Resume Next 'Проверка на поддержку свойства Value.
    a(0).Value = t
    f2 = Err.Number = 438
    
    On Error GoTo LblTerminationB
    Set eRng = eRng.Areas(1)
    arr = eRng
    rr = UBound(arr)
    cc = UBound(arr, 2)
    If r < rr Then rr = r
    If c < cc Then cc = c
    If f2 Then 'Выбираем способ заполнения в зависимости от поддержки свойства Value.
        For i = 1 To rr
            For j = 1 To cc
                Set src = a(i - 1, j - 1)
                src.Unserialize arr(i, j)
            Next j
        Next i
    Else
        For i = 1 To rr
            For j = 1 To cc
                a(i - 1, j - 1) = arr(i, j)
            Next j
        Next i
    End If
    On Error GoTo 0
    If f1 Then eWbk.Close False
    If f0 Then eApp.Quit
    Exit Sub
 
ErrAppNotOpenB:
    If Err.Number = 429 Then 'Приложение Excel не открыто.
        f0 = True
        Set eApp = CreateObject("Excel.Application")
        Resume Next
    Else
        GoTo LblTerminationB
    End If
 
ErrWbkNotOpenB:
    If Err.Number = 9 Then 'Искомая книга не открыта в текущем приложении Excel.
        f1 = True
        Set eWbk = eApp.Workbooks.Open(fileName)
        Resume Next
    Else
        GoTo LblTerminationB
    End If
    
LblTerminationB: 'Аварийное завершение программы с освобождением использованных ресурсов.
    If f1 Then
        eWbk.Close False
        Set eWbk = Nothing
    End If
    If f0 Then
        eApp.Quit
        Set eApp = Nothing
    End If
    Err.Raise Err.Number, Err.Source, Err.Description, Err.HelpFile, Err.HelpContext
End Sub
'Преобразование времени в секундах в часы, минуты (от 0 до 59) и секунды (от 0 до 59).
Private Sub SecsToHMS(ByVal secs As Long, ByRef hms() As Integer)
    hms(2) = secs Mod 60
    secs = secs \ 60
    hms(1) = secs Mod 60
    hms(0) = secs \ 60
End Sub
'Функция, выполняющая корректное сложение дат, представленных в разных форматах.
Private Function SumDates(ByVal d1 As Date, ByVal d2 As Date) As Date
    Dim d1p(0 To 5) As Integer, d2p(0 To 5) As Integer
    Dim i As Long, k As Long, arr As Variant
    arr = Array("yyyy", "m", "d", "h", "n", "s")
    For i = 0 To 5
        d1p(i) = DatePart(arr(i), d1)
        d2p(i) = DatePart(arr(i), d2)
    Next i
    k = 4 * (CLng((d1p(0) = 1899) And (d1p(1) = 12) And (d1p(2) = 30)) + _
    2 * CLng((d1p(3) = 0) And (d1p(4) = 0) And (d1p(5) = 0))) + _
    CLng((d2p(0) = 1899) And (d2p(1) = 12) And (d2p(2) = 30)) + _
    2 * CLng((d2p(3) = 0) And (d2p(4) = 0) And (d2p(5) = 0))
    Select Case k
        Case 0
            For i = 0 To 5
                d1 = DateAdd(arr(i), d2p(i), d1)
            Next i
        Case -1, -9
            For i = 3 To 5
                d1 = DateAdd(arr(i), d2p(i), d1)
            Next i
        Case -2, -10
            For i = 0 To 2
                d1 = DateAdd(arr(i), d2p(i), d1)
            Next i
        Case -4, -5, -6
            For i = 3 To 5
                d2 = DateAdd(arr(i), d1p(i), d2)
            Next i
        Case -8, -10
            For i = 0 To 2
                d2 = DateAdd(arr(i), d1p(i), d2)
            Next i
    End Select
    Select Case k
        Case 0, -1, -2, -3, -7, -9, -10, -11
            SumDates = d1
        Case -4, -5, -6, -8, -12, -13, -14, -15
            SumDates = d2
    End Select
End Function

'Процедура для заполения матрицы данными, сгенерированными с помощью генератора случайных чисел.
'Данные генерируются в диапазоне от low_val (включительно) до high_val (включительно), либо в
'диапазоне, определенном по умолчанию. Параметр seed определяет число, используемое для
'генерации последовательности (псевдо)случайных чисел, а параметр floatPrecision - точность,
'до которой округляются вещественные числа (если параметр floatPrecision не задан, вещественные
'числа не округляются). В качестве данных генератор умеет генерировать числа, символы и даты.
'Базовые принципы процесса генерации описаны в классе AksiVector.
Public Sub GetData_RandomGenerator(Optional ByVal low_val, Optional ByVal high_val, _
Optional ByVal seed, Optional ByVal floatPrecision)
    Dim i As Long, j As Long, s As Long, multiplier As Long, arr As Variant
    Dim d1p(0 To 5) As Integer, d2p(0 To 5) As Integer, dp(0 To 2) As Integer
    Dim d1f As Long, d2f As Long, dif As Long, k As Long, d As Date, t As Date
    If IsMissing(seed) Then Randomize Else Randomize Val(seed)
    If IsMissing(low_val) Then
        If IsMissing(high_val) Then
            Select Case TypeName(a(0, 0))
                Case "AksiInteger"
                    For i = 0 To r - 1
                        For j = 0 To c - 1
                            a(i, j) = Int(100 * Rnd)
                        Next j
                    Next i
                Case "AksiFloat"
                    If IsMissing(floatPrecision) Then
                        For i = 0 To r - 1
                            For j = 0 To c - 1
                                a(i, j) = 100 * Rnd - 50
                            Next j
                        Next i
                    Else
                        If IsNumeric(floatPrecision) Then
                            floatPrecision = CByte(Val(floatPrecision))
                            If floatPrecision = 0 Then
                                For i = 0 To r - 1
                                    For j = 0 To c - 1
                                        a(i, j) = Int(101 * Rnd - 50)
                                    Next j
                                Next i
                            Else
                                multiplier = 10 ^ floatPrecision
                                For i = 0 To r - 1
                                    For j = 0 To c - 1
                                        a(i, j) = Int(2 * (Rnd - 0.5) * multiplier) / multiplier
                                    Next j
                                Next i
                            End If
                        Else
                            Err.Raise 13
                        End If
                    End If
                Case "AksiChar"
                    For i = 0 To r - 1
                        For j = 0 To c - 1
                            a(i, j) = Int(256 * Rnd)
                        Next j
                    Next i
                Case "AksiDate"
                        high_val = Now
                        low_val = DateAdd("yyyy", -1, high_val)
                        arr = Array("yyyy", "m", "d", "h", "n", "s")
                        For i = 3 To 5
                            d1p(i) = DatePart(arr(i), low_val)
                        Next i
                        dif = DateDiff("d", low_val, high_val)
                        For i = 0 To r - 1
                            For j = 0 To c - 1
                                d = DateAdd("d", Int((dif + 1) * Rnd), low_val)
                                SecsToHMS Int(86400 * Rnd), dp
                                a(i, j) = SumDates(d, TimeSerial(dp(0), dp(1), dp(2)))
                            Next j
                        Next i
                Case Else
                    Err.Raise 5
            End Select
        Else
            Err.Raise 5
        End If
    Else
        If IsMissing(high_val) Then
            Err.Raise 5
        Else
            Select Case TypeName(a(0, 0))
                Case "AksiInteger"
                    If IsNumeric(low_val) And IsNumeric(high_val) Then
                        low_val = Val(low_val)
                        high_val = Val(high_val)
                        If low_val - CLng(low_val) = 0 And high_val - CLng(high_val) = 0 Then
                            If low_val > high_val Then
                                Err.Raise 5, , "Неверные аргументы - нижняя граница больше верхней" & _
                                vbCr & "(Invalid argument(s) - low_val is greater than high_val)."
                            Else
                                For i = 0 To r - 1
                                    For j = 0 To c - 1
                                        a(i, j) = Int((high_val - low_val + 1) * Rnd + low_val)
                                    Next j
                                Next i
                            End If
                        Else
                            Err.Raise 5, , "Неверные аргументы - границы должны быть целыми" & _
                            vbCr & "(Invalid argument(s) - bounds must be integers)."
                        End If
                    Else
                        Err.Raise 13
                    End If
                Case "AksiFloat"
                    If IsNumeric(low_val) And IsNumeric(high_val) Then
                        low_val = Val(low_val)
                        high_val = Val(high_val)
                        If low_val > high_val Then
                            Err.Raise 5, , "Неверные аргументы - нижняя граница больше верхней" & _
                            vbCr & "(Invalid argument(s) - low_val is greater than high_val)."
                        Else
                            If IsMissing(floatPrecision) Then
                                For i = 0 To r - 1
                                    For j = 0 To c - 1
                                        a(i, j) = (high_val - low_val) * Rnd + low_val
                                    Next j
                                Next i
                            Else
                                If IsNumeric(floatPrecision) Then
                                    floatPrecision = CByte(Val(floatPrecision))
                                    multiplier = 10 ^ floatPrecision
                                    For i = 0 To r - 1
                                        For j = 0 To c - 1
                                            a(i, j) = (Int((high_val - low_val) * Rnd + low_val) * multiplier) / multiplier
                                        Next j
                                    Next i
                                Else
                                    Err.Raise 13
                                End If
                            End If
                        End If
                    Else
                        Err.Raise 13
                    End If
                Case "AksiChar"
                    If TypeName(low_val) = "String" And TypeName(high_val) = "String" Then
                        If Len(low_val) = 1 And Len(high_val) = 1 Then
                            low_val = Asc(low_val)
                            high_val = Asc(high_val)
                            If low_val > high_val Then
                                Err.Raise 5, , "Неверные аргументы - нижняя граница больше верхней" & _
                                vbCr & "(Invalid argument(s) - low_val is greater than high_val)."
                            Else
                                For i = 0 To r - 1
                                    For j = 0 To c - 1
                                        a(i, j) = Int((high_val - low_val + 1) * Rnd + low_val)
                                    Next j
                                Next i
                            End If
                        Else
                            Err.Raise 5, , "Неверные аргументы - границы представляются 1 символом." & _
                            vbCr & "(Invalid argument(s) - bounds must be 1-char symbols)."
                        End If
                    Else
                        low_val = CByte(Val(low_val))
                        high_val = CByte(Val(high_val))
                        If low_val > high_val Then
                            Err.Raise 5, , "Неверные аргументы - нижняя граница больше верхней" & _
                            vbCr & "(Invalid argument(s) - low_val is greater than high_val)."
                        Else
                            For i = 0 To r - 1
                                For j = 0 To c - 1
                                    a(i, j) = Int((high_val - low_val + 1) * Rnd + low_val)
                                Next j
                            Next i
                        End If
                    End If
                Case "AksiDate"
                    If IsDate(low_val) And IsDate(high_val) Then
                        low_val = CDate(low_val)
                        high_val = CDate(high_val)
                        arr = Array("yyyy", "m", "d", "h", "n", "s")
                        For i = 0 To 5
                            d1p(i) = DatePart(arr(i), low_val)
                            d2p(i) = DatePart(arr(i), high_val)
                        Next i
                        d1f = CLng((d1p(0) = 1899) And (d1p(1) = 12) And (d1p(2) = 30)) + _
                            2 * CLng((d1p(3) = 0) And (d1p(4) = 0) And (d1p(5) = 0))
                        d2f = CLng((d2p(0) = 1899) And (d2p(1) = 12) And (d2p(2) = 30)) + _
                            2 * CLng((d2p(3) = 0) And (d2p(4) = 0) And (d2p(5) = 0))
                        k = 4 * d1f + d2f
                        Select Case k
                            Case 0, -2, -8
                                If low_val > high_val Then
                                    Err.Raise 5, , "Неверные аргументы - нижняя граница больше верхней" & _
                                    vbCr & "(Invalid argument(s) - low_val is greater than high_val)."
                                Else
                                    If d1p(0) = d2p(0) And d1p(1) = d2p(1) And d1p(2) = d2p(2) Then
                                        s = 3600& * d1p(3) + 60& * d1p(4) + d1p(5)
                                        dif = 3600& * d2p(3) + 60& * d2p(4) + d2p(5) - s
                                        For i = 0 To r - 1
                                            For j = 0 To c - 1
                                                SecsToHMS Int((dif + 1) * Rnd + s), dp
                                                a(i, j) = SumDates(DateSerial(d1p(0), d1p(1), d1p(2)), _
                                                TimeSerial(dp(0), dp(1), dp(2)))
                                            Next j
                                        Next i
                                    Else
                                        dif = DateDiff("d", low_val, high_val)
                                        For i = 0 To r - 1
                                            For j = 0 To c - 1
                                                d = DateAdd("d", Int((dif + 1) * Rnd), low_val)
                                                If d = DateSerial(d1p(0), d1p(1), d1p(2)) Then
                                                    s = 3600& * d1p(3) + 60& * d1p(4) + d1p(5)
                                                    SecsToHMS Int((86400 - s) * Rnd + s), dp
                                                    a(i, j) = SumDates(d, TimeSerial(dp(0), dp(1), dp(2)))
                                                ElseIf d = DateSerial(d2p(0), d2p(1), d2p(2)) Then
                                                    s = 3600& * d2p(3) + 60& * d2p(4) + d2p(5)
                                                    SecsToHMS Int((s + 1) * Rnd), dp
                                                    a(i, j) = SumDates(d, TimeSerial(dp(0), dp(1), dp(2)))
                                                Else
                                                    SecsToHMS Int(86400 * Rnd), dp
                                                    a(i, j) = SumDates(d, TimeSerial(dp(0), dp(1), dp(2)))
                                                End If
                                            Next j
                                        Next i
                                    End If
                                End If
                            Case -1, -4, -5, -9, -12, -13
                                If TimeSerial(d1p(3), d1p(4), d1p(5)) > TimeSerial(d2p(3), d2p(4), d2p(5)) Then
                                    Err.Raise 5, , "Неверные аргументы - нижняя граница больше верхней" & _
                                    vbCr & "(Invalid argument(s) - low_val is greater than high_val)."
                                Else
                                    s = 3600& * d1p(3) + 60& * d1p(4) + d1p(5)
                                    dif = 3600& * d2p(3) + 60& * d2p(4) + d2p(5) - s
                                    Select Case k
                                        Case -1
                                            d = DateSerial(d1p(0), d1p(1), d1p(2))
                                        Case -4
                                            d = DateSerial(d2p(0), d2p(1), d2p(2))
                                        Case -5
                                            d = #12:00:00 AM#
                                        Case -9
                                            d = low_val
                                        Case -12
                                            d = DateSerial(d2p(0), d2p(1), d2p(2))
                                        Case -13
                                            d = #12:00:00 AM#
                                    End Select
                                    For i = 0 To r - 1
                                        For j = 0 To c - 1
                                            SecsToHMS Int((dif + 1) * Rnd + s), dp
                                            t = TimeSerial(dp(0), dp(1), dp(2))
                                            a(i, j) = SumDates(d, TimeSerial(dp(0), dp(1), dp(2)))
                                        Next j
                                    Next i
                                End If
                            Case -3, -6, -7, -11
                                Err.Raise 5, , "Неверные аргументы - нижняя граница больше верхней" & _
                                vbCr & "(Invalid argument(s) - low_val is greater than high_val)."
                            Case -10
                                If low_val > high_val Then
                                    Err.Raise 5, , "Неверные аргументы - нижняя граница больше верхней" & _
                                    vbCr & "(Invalid argument(s) - low_val is greater than high_val)."
                                Else
                                    dif = DateDiff("d", low_val, high_val)
                                    For i = 0 To r - 1
                                        For j = 0 To c - 1
                                            a(i, j) = DateAdd("d", Int((dif + 1) * Rnd), low_val)
                                        Next j
                                    Next i
                                End If
                            Case -14
                                For i = 0 To r - 1
                                    For j = 0 To c - 1
                                        a(i, j) = high_val
                                    Next j
                                Next i
                            Case -15
                                For i = 0 To r - 1
                                    For j = 0 To c - 1
                                        a(i, j) = #12:00:00 AM#
                                    Next j
                                Next i
                        End Select
                    Else
                        Err.Raise 13
                    End If
                Case Else
                    Err.Raise 5
            End Select
        End If
    End If
End Sub
'Процедура для чтения данных в матрицу из заданного вектора. Параметр vec определяет
'ссылку на вектор, их которого считываются элементы матрицы, а параметр readorder
'задает порядок, в котором они считываются.
Public Sub GetData_Vector(ByVal vec As AksiVector, Optional ByVal readorder As AoMatrixReadOrder = AO_BYROWS)
    Dim i As Long, j As Long, N As Long
    Select Case readorder
        Case AO_BYROWS
            For i = 0 To r - 1
                For j = 0 To c - 1
                    N = i * c + j
                    If N > vec.Count - 1 Then Exit Sub
                    Set a(i, j) = vec(N)
                Next j
            Next i
        Case AO_BYCOLS
            For i = 0 To r - 1
                For j = 0 To c - 1
                    N = i + j * r
                    If N > vec.Count - 1 Then Exit Sub
                    Set a(i, j) = vec(N)
                Next j
            Next i
        Case Else
            Err.Raise 5
    End Select
End Sub
'Процедура для представления элементов матрицы в виде вектора. Параметр readorder
'задает порядок, в котором элементы матрицы считываются в вектор.
Public Function Elements(Optional ByVal readorder As AoMatrixReadOrder = AO_BYROWS) As AksiVector
    Dim i As Long, j As Long, v As AksiVector
    Select Case readorder
        Case AO_BYROWS
            Set v = New AksiVector
            v.Init a(0, 0), r * c
            For i = 0 To r - 1
                For j = 0 To c - 1
                    Set v(i * c + j) = a(i, j)
                Next j
            Next i
        Case AO_BYCOLS
            Set v = New AksiVector
            v.Init a(0, 0), r * c
            For i = 0 To r - 1
                For j = 0 To c - 1
                    Set v(i + j * r) = a(i, j)
                Next j
            Next i
        Case Else
            Err.Raise 5
    End Select
    Set Elements = v
End Function

'Процедура, возвращающая заданную часть матрицы в виде вектора.
Public Function Parts(ByVal part As AoMatrixParts) As AksiVector
    Dim i As Long, j As Long, k As Long, v As AksiVector, f As IFactory
    Select Case part
        Case AO_WHOLE
            Set v = Elements
        Case AO_ROWS
            Set v = New AksiVector
            v.Init New AksiVector, r
            Set f = a(0, 0)
            For i = 0 To r - 1
                v(i).Init f.NewOb, c
                For j = 0 To c - 1
                    Set v(i)(j) = a(i, j)
                Next j
            Next i
        Case AO_COLUMNS
            Set v = New AksiVector
            v.Init New AksiVector, c
            Set f = a(0, 0)
            For i = 0 To c - 1
                v(i).Init f.NewOb, r
                For j = 0 To r - 1
                    Set v(i)(j) = a(j, i)
                Next j
            Next i
        Case AO_MAIN_DIAG
            Set v = New AksiVector
            If r = c Then
                Set f = a(0, 0)
                v.Init f.NewOb, r
                For i = 0 To r - 1
                    Set v(i) = a(i, i)
                Next i
            Else
                Err.Raise 5
            End If
        Case AO_SIDE_DIAG
            Set v = New AksiVector
            If r = c Then
                Set f = a(0, 0)
                v.Init f.NewOb, r
                For i = 0 To r - 1
                    Set v(i) = a(r - i - 1, i)
                Next i
            Else
                Err.Raise 5
            End If
        Case AO_UP_MAIN_EXC
            Set v = New AksiVector
            If r = c Then
                Set f = a(0, 0)
                v.Init f.NewOb, r * (r - 1) / 2
                k = 0
                For i = 0 To r - 2
                    For j = 1 + i To r - 1
                        Set v(k) = a(i, j)
                        k = k + 1
                    Next j
                Next i
            Else
                Err.Raise 5
            End If
        Case AO_DOWN_MAIN_EXC
            Set v = New AksiVector
            If r = c Then
                Set f = a(0, 0)
                v.Init f.NewOb, r * (r - 1) / 2
                k = 0
                For i = 1 To r - 1
                    For j = 0 To i - 1
                        Set v(k) = a(i, j)
                        k = k + 1
                    Next j
                Next i
            Else
                Err.Raise 5
            End If
        Case AO_UP_SIDE_EXC
            Set v = New AksiVector
            If r = c Then
                Set f = a(0, 0)
                v.Init f.NewOb, r * (r - 1) / 2
                k = 0
                For i = 0 To r - 2
                    For j = 0 To r - i - 2
                        Set v(k) = a(i, j)
                        k = k + 1
                    Next j
                Next i
            Else
                Err.Raise 5
            End If
        Case AO_DOWN_SIDE_EXC
            Set v = New AksiVector
            If r = c Then
                Set f = a(0, 0)
                v.Init f.NewOb, r * (r - 1) / 2
                k = 0
                For i = 1 To r - 1
                    For j = r - i To r - 1
                        Set v(k) = a(i, j)
                        k = k + 1
                    Next j
                Next i
            Else
                Err.Raise 5
            End If
        Case AO_UP_MAIN_INC
            Set v = New AksiVector
            If r = c Then
                Set f = a(0, 0)
                v.Init f.NewOb, r * (r + 1) / 2
                k = 0
                For i = 0 To r - 1
                    For j = i To r - 1
                        Set v(k) = a(i, j)
                        k = k + 1
                    Next j
                Next i
            Else
                Err.Raise 5
            End If
        Case AO_DOWN_MAIN_INC
            Set v = New AksiVector
            If r = c Then
                Set f = a(0, 0)
                v.Init f.NewOb, r * (r + 1) / 2
                k = 0
                For i = 0 To r - 1
                    For j = 0 To i
                        Set v(k) = a(i, j)
                        k = k + 1
                    Next j
                Next i
            Else
                Err.Raise 5
            End If
        Case AO_UP_SIDE_INC
            Set v = New AksiVector
            If r = c Then
                Set f = a(0, 0)
                v.Init f.NewOb, r * (r + 1) / 2
                k = 0
                For i = 0 To r - 1
                    For j = 0 To r - i - 1
                        Set v(k) = a(i, j)
                        k = k + 1
                    Next j
                Next i
            Else
                Err.Raise 5
            End If
        Case AO_DOWN_SIDE_INC
            Set v = New AksiVector
            If r = c Then
                Set f = a(0, 0)
                v.Init f.NewOb, r * (r + 1) / 2
                k = 0
                For i = 0 To r - 1
                    For j = r - i - 1 To r - 1
                        Set v(k) = a(i, j)
                        k = k + 1
                    Next j
                Next i
            Else
                Err.Raise 5
            End If
        Case Else
            Err.Raise 5
    End Select
    Set Parts = v
End Function
'Процедура сортировки элементов матрицы. Параметр readorder определяет порядок чтения
'матрицы в вектор. Параметр method определяет алгоритм, применяемый при сортировке,
'а параметр direction определяет порядок сортировки (восходящая или нисходящая).
'Параметр cmp - объект, определяющий способ сравнения сортируемых объектов. Если он
'не используется, то применяется способ сравения, встроенный в базовый элемент матрицы
'(для этого базовый элемент должен поддерживать интерфейс IComparable).
Public Sub Sort(Optional ByVal readorder As AoMatrixReadOrder = AO_BYROWS, _
Optional ByVal method As AoSortMethod = AO_BUBBLE, _
Optional ByVal direction As AoSortOrder = AO_ASC, Optional ByVal cmp As IComparer)
    Dim v As AksiVector
    Set v = Elements(readorder)
    v.Sort method, direction, cmp
    GetData_Vector v, readorder
End Sub
'Функция для получения максимального элемента матрицы.
Public Function Max(Optional ByVal cmp As IComparer) As Object
    Set Max = Elements.Max(cmp)
End Function
'Функция для получения минимального элемента матрицы.
Public Function Min(Optional ByVal cmp As IComparer) As Object
    Set Min = Elements.Min(cmp)
End Function
'Сумма элементов матрицы.
Public Property Get Sum() As Object
    Set Sum = Elements.Sum
End Property
'Произведение элементов матрицы.
Public Property Get Product() As Object
    Set Product = Elements.Product
End Property
'Среднее арифметческое элементов матрицы.
Public Property Get Average() As Object
    Set Average = Elements.Average
End Property

'________________________________________________________________
'_______________________                   ______________________
'_____________________    Модуль AksiCube   _____________________
'____________________      Версия: 0.9.0     ____________________
'___________________       Автор: Aksima      ___________________
'___________________  Библиотека: AksiArrays  ___________________
'________________________________________________________________
'_______                                                  _______
'_______  Назначение: Реализует куб - трехмерный массив.  _______
'________________________________________________________________
 
Enum AoCubeReadOrder 'Порядок чтения элементов куба.
    AO_XROWS 'Куб считывается по строкам каждого x-слоя.
    AO_XCOLS 'Куб считывается по столбцам каждого x-слоя.
    AO_YROWS 'Куб считывается по строкам каждого y-слоя.
    AO_YCOLS 'Куб считывается по столбцам каждого y-слоя.
    AO_ZROWS 'Куб считывается по строкам каждого z-слоя.
    AO_ZCOLS 'Куб считывается по столбцам каждого z-слоя.
End Enum
Dim a() As Object
Dim x As Long, y As Long, z As Long
'Инициализация куба с размерностями xSize, ySize, zSize и базовым объектом base.
'Базовый объект должен поддерживать интерфейс IFactory.
Public Sub Init(ByVal base As Object, ByVal xSize As Long, ByVal ySize As Long, ByVal zSize As Long)
    Dim i As Long, j As Long, k As Long, f As IFactory
    x = xSize
    y = ySize
    z = zSize
    Set f = base
    ReDim a(0 To x - 1, 0 To y - 1, 0 To z - 1) As Object
    For i = 0 To x - 1
        For j = 0 To y - 1
            For k = 0 To z - 1
                Set a(i, j, k) = f.NewOb
            Next k
        Next j
    Next i
End Sub
'Получение ссылки на элемент куба по индексам.
Public Property Get Item(ByVal xIndex As Long, ByVal yIndex As Long, ByVal zIndex As Long) As Object
    Set Item = a(xIndex, yIndex, zIndex)
End Property
'Установка ссылки для элемента куба с заданными индексами.
Public Property Set Item(ByVal xIndex As Long, ByVal yIndex As Long, ByVal zIndex As Long, ByVal eNew As Object)
    If TypeName(a(xIndex, yIndex, zIndex)) = TypeName(eNew) Then Set a(xIndex, yIndex, zIndex) = eNew Else Err.Raise 13
End Property
'Получение общего количества элементов в кубе.
Public Property Get Count() As Long
    Count = x * y * z
End Property
'Получение количества слоев в кубе вдоль x-координаты.
Public Property Get CountX() As Long
    CountX = x
End Property
'Получение количества слоев в кубе вдоль y-координаты.
Public Property Get CountY() As Long
    CountY = y
End Property
'Получение количества слоев в кубе вдоль z-координаты.
Public Property Get CountZ() As Long
    CountZ = z
End Property
'Процедура для записи данных из куба в текстовый файл с именем fileName.
'Базовый объект куба должен поддерживать интерфейс ISerializable.
Public Sub PutData_TextFile(ByVal fileName As String)
    Dim i As Long, j As Long, k As Long, N As Long, s As String
    Dim t As AksiCatalog, f As New AksiFile, src As ISerializable
    f.Parse fileName
    If f.Path <> "\" Then
        Set src = a(0, 0, 0)
        s = src.Serialize
        For j = 1 To y - 1
            Set src = a(0, j, 0)
            s = s & "," & src.Serialize
        Next j
        For i = 1 To x - 1
            Set src = a(i, 0, 0)
            s = s & vbCrLf & src.Serialize
            For j = 1 To y - 1
                Set src = a(i, j, 0)
                s = s & "," & src.Serialize
            Next j
        Next i
        For k = 1 To z - 1
            Set src = a(0, 0, k)
            'Разделитель между z-слоями куба.
            s = s & vbCrLf & Chr(29) & Chr(30) & vbCrLf & src.Serialize
            For j = 1 To y - 1
                Set src = a(0, j, k)
                s = s & "," & src.Serialize
            Next j
            For i = 1 To x - 1
                Set src = a(i, 0, k)
                s = s & vbCrLf & src.Serialize
                For j = 1 To y - 1
                    Set src = a(i, j, k)
                    s = s & "," & src.Serialize
                Next j
            Next i
        Next k
        f.Catalog.MakeSureCatalogExists
        N = FreeFile
        Open fileName For Output As #N
        Print #N, s
        Close #N
    Else
        Set t = New AksiCatalog
        Set f = t.FileFind(f.Name)
        If f Is Nothing Then
            f.Name = fileName
            f.FullNameDialog "Файл " & f.Name & " не найден", "file " & f.Name & " not found"
        ElseIf f.FullName = "\" Then
            f.Name = fileName
            f.FullNameDialog "Файл " & f.Name & " не найден", "file " & f.Name & " not found"
        End If
        Set src = a(0, 0, 0)
        s = src.Serialize
        For j = 1 To y - 1
            Set src = a(0, j, 0)
            s = s & "," & src.Serialize
        Next j
        For i = 1 To x - 1
            Set src = a(i, 0, 0)
            s = s & vbCrLf & src.Serialize
            For j = 1 To y - 1
                Set src = a(i, j, 0)
                s = s & "," & src.Serialize
            Next j
        Next i
        For k = 1 To z - 1
            Set src = a(0, 0, k)
            'Разделитель между z-слоями куба.
            s = s & vbCrLf & Chr(29) & Chr(30) & vbCrLf & src.Serialize
            For j = 1 To y - 1
                Set src = a(0, j, k)
                s = s & "," & src.Serialize
            Next j
            For i = 1 To x - 1
                Set src = a(i, 0, k)
                s = s & vbCrLf & src.Serialize
                For j = 1 To y - 1
                    Set src = a(i, j, k)
                    s = s & "," & src.Serialize
                Next j
            Next i
        Next k
        N = FreeFile
        Open f.FullName For Output As #N
        Print #N, s
        Close #N
    End If
End Sub
'Процедура для чтения данных в куб из текстового файла с именем fileName.
'Базовый объект куба должен поддерживать интерфейс ISerializable.
Public Sub GetData_TextFile(ByVal fileName As String)
    Dim i As Long, j As Long, k As Long, N As Long, f As Long, p As Long, q As Long
    Dim s As String, ss As String, e() As String, es As Collection
    Dim f As New AksiFile, t As AksiCatalog, rec As ISerializable
    f.Parse fileName
    If f.Path = "\" Then
        Set t = New AksiCatalog
        Set f = t.FileFind(fileName)
        If f Is Nothing Then
            f.Name = fileName
            f.FullNameDialog "Файл " & f.Name & " не найден", "file " & f.Name & " not found"
        ElseIf f.FullName = "\" Then
            f.Name = fileName
            f.FullNameDialog "Файл " & f.Name & " не найден", "file " & f.Name & " not found"
        End If
    End If
    N = FreeFile
    Open f.FullName For Input As #N
    Set es = New Collection
    Do
        For i = 0 To x - 1
            If EOF(N) Then Exit Do
            Line Input #N, s
            'Если строка представляет собой разделитель z-слоя,
            'то заканчиваем заполнение матрицы для текущего z-слоя.
            If s = Chr(29) & Chr(30) Then Exit For
            'Иначе анализируем эту и следующие строки
            '(описание процедуры есть в классе AksiMatrix).
            Set es = New Collection
            p = InStr(s, """")
            While p > 0
                ss = Trim(Left(s, p - 1))
                If Right(ss, 1) = "," Then ss = Trim(Left(ss, Len(ss) - 1))
                e = Split(ss, ",")
                For j = 0 To UBound(e)
                    es.Add e(j)
                Next j
                q = InStr(p + 1, s, """")
                If q = 0 Then q = Len(s) + 1
                es.Add Mid(s, p + 1, q - p - 1)
                s = Trim(Mid(s, q + 1))
                If Left(s, 1) = "," Then s = Trim(Mid(s, 2))
                p = InStr(s, """")
            Wend
            e = Split(s, ",")
            For j = 0 To UBound(e)
                es.Add e(j)
            Next j
            For j = 0 To IIf(y < es.Count, y - 1, es.Count - 1)
                Set rec = a(i, j, k)
                rec.Unserialize es(j + 1)
            Next j
        Next i
        If i = x Then k = k + 1
        If k > z - 1 Then Exit Do 'Если заполнили куб - выходим досрочно.
    Loop
    Close #N
End Sub
'Процедура для вывода целых чисел как есть, чисел в экспоненциальном формате -
'- без дробной части, а остальных - с двумя знаками после запятой.
Private Function CutAfterDecimal(ByVal x As Double) As String
    If InStr(x, Format(0, ".")) Then
        If InStr(x, "E") Then
            CutAfterDecimal = Format(x, "0E+")
        Else
            CutAfterDecimal = Format(x, "0.00")
        End If
    Else
        CutAfterDecimal = x
    End If
End Function
'Процедура для вывода данных из куба в диалоговые окна. Ввиду ограничений
'на размер диалогового окна, вывод поддерживается только для кубов на основе
'классов AksiInteger, AksiFloat или AksiChar, либо кубов, элементы которых
'выражаются строками длиной не более восьми элементов.
Public Sub PutData_DialogBox(Optional ByVal title As String)
    Dim i As Long, j As Long, k As Long, s As String, t As String, src As ISerializable
    If x > 12 Or y > 8 Or z > 20 Then Err.Raise vbObjectError, , _
    "Операция слишком велика (Operation too large)" & vbCr & _
    "Вы пытаетесь вывести в диалоговые окна куб, количество" & vbCr & _
    "элементов которого в одном из измерений больше лимита." & vbCr & _
    "Допускается вывод не более 12 строк, 8 столбцов, 20 слоев." & vbCr & _
    "(You are trying to put into dialog boxes a cube with dimensions" & vbCr & _
    "larger than allowed limit (max 12 rows, 8 columns, 20 layers)."
    Select Case TypeName(a(0, 0, 0))
        Case "AksiInteger"
            For k = 0 To z - 1
                s = a(0, 0, k)
                For j = 1 To y - 1
                    s = s & vbTab & a(0, j, k)
                Next j
                For i = 1 To x - 1
                    s = s & vbCrLf & a(i, 0, k)
                    For j = 1 To y - 1
                        s = s & vbTab & a(i, j, k)
                    Next j
                Next i
                If title <> vbNullString Then
                    MsgBox s, , title & ": слой " & k + 1 & " из " & z & " (layer " & k + 1 & " of " & z & ")"
                Else
                    MsgBox s, , "Cлой " & k + 1 & " из " & z & " (layer " & k + 1 & " of " & z & ")"
                End If
            Next k
        Case "AksiFloat"
            For k = 0 To z - 1
                s = CutAfterDecimal(a(0, 0, k))
                For j = 1 To y - 1
                    s = s & vbTab & CutAfterDecimal(a(0, j, k))
                Next j
                For i = 1 To x - 1
                    s = s & vbCrLf & CutAfterDecimal(a(i, 0, k))
                    For j = 1 To y - 1
                        s = s & vbTab & CutAfterDecimal(a(i, j, k))
                    Next j
                Next i
                If title <> vbNullString Then
                    MsgBox s, , title & ": слой " & k + 1 & " из " & z & " (layer " & k + 1 & " of " & z & ")"
                Else
                    MsgBox s, , "Cлой " & k + 1 & " из " & z & " (layer " & k + 1 & " of " & z & ")"
                End If
            Next k
        Case "AksiChar"
            For k = 0 To z - 1
                s = Chr(a(0, 0, k))
                For j = 1 To y - 1
                    s = s & vbTab & Chr(a(0, j, k))
                Next j
                For i = 1 To x - 1
                    s = s & vbCrLf & Chr(a(i, 0, k))
                    For j = 1 To y - 1
                        s = s & vbTab & Chr(a(i, j, k))
                    Next j
                Next i
                If title <> vbNullString Then
                    MsgBox s, , title & ": слой " & k + 1 & " из " & z & " (layer " & k + 1 & " of " & z & ")"
                Else
                    MsgBox s, , "Cлой " & k + 1 & " из " & z & " (layer " & k + 1 & " of " & z & ")"
                End If
            Next k
        Case "AksiString"
            For k = 0 To z - 1
                If Len(a(0, 0, k)) > 8 Then GoTo ErrTooLargeString Else s = a(0, 0, k)
                For j = 1 To y - 1
                    If Len(a(0, j, k)) > 8 Then GoTo ErrTooLargeString Else s = s & vbTab & a(0, j, k)
                Next j
                For i = 1 To x - 1
                    If Len(a(i, 0, k)) > 8 Then GoTo ErrTooLargeString Else s = s & vbCrLf & a(i, 0, k)
                    For j = 1 To y - 1
                        If Len(a(i, j, k)) > 8 Then GoTo ErrTooLargeString Else s = s & vbTab & a(i, j, k)
                    Next j
                Next i
                If title <> vbNullString Then
                    MsgBox s, , title & ": слой " & k + 1 & " из " & z & " (layer " & k + 1 & " of " & z & ")"
                Else
                    MsgBox s, , "Cлой " & k + 1 & " из " & z & " (layer " & k + 1 & " of " & z & ")"
                End If
            Next k
        Case Else
            For k = 0 To z - 1
                Set src = a(0, 0, k)
                t = src.Serialize
                If Len(t) > 8 Then GoTo ErrTooLargeString Else s = t
                For j = 1 To y - 1
                    Set src = a(0, j, k)
                    t = src.Serialize
                    If Len(t) > 8 Then GoTo ErrTooLargeString Else s = s & vbTab & t
                Next j
                For i = 1 To x - 1
                    Set src = a(i, 0, k)
                    t = src.Serialize
                    If Len(t) > 8 Then GoTo ErrTooLargeString Else s = s & vbCrLf & t
                    For j = 1 To y - 1
                        Set src = a(i, j, k)
                        t = src.Serialize
                        If Len(t) > 8 Then GoTo ErrTooLargeString Else s = s & vbTab & t
                    Next j
                Next i
                If title <> vbNullString Then
                    MsgBox s, , title & ": слой " & k + 1 & " из " & z & " (layer " & k + 1 & " of " & z & ")"
                Else
                    MsgBox s, , "Cлой " & k + 1 & " из " & z & " (layer " & k + 1 & " of " & z & ")"
                End If
            Next k
    End Select
    Exit Sub
 
ErrTooLargeString:
    Err.Raise vbObjectError, , "Операция слишком велика (Operation too large)" & _
    vbCr & "Вы пытаетесь вывести в диалоговое окно слой, элементы" & vbCr & _
    "которого не помещаются в пространстве, выделенном для" & vbCr & _
    "диалогового окна." & vbCr & _
    "(You are trying to put into dialog box a layer with elements" & vbCr & _
    "which cannot be displayed in dialog box reserved space."
End Sub