SNIPPETS.json

{
  "tableName": "TB_SNIPETS",
  "version_add_in": "2.0.39",
  "data": [
    {
      "CODE_GRUP": "App", 
      "CODE_SNIPPET": "CalAu", 
      "CODE": "Application.Calculation =xlCalculationAutomatic", 
      "DISCRIPTION": "Application.Calculation =xlCalculationAutomatic"
    }, 
    {
      "CODE_GRUP": "App", 
      "CODE_SNIPPET": "CalMa", 
      "CODE": "Application.Calculation=xlCalculationManual", 
      "DISCRIPTION": "Application.Calculation=xlCalculationManual"
    }, 
    {
      "CODE_GRUP": "App", 
      "CODE_SNIPPET": "Enum_", 
      "CODE": "Enum @1\r\r\n    \r\r\nEnd Enum", 
      "DISCRIPTION": "Enum "
    }, 
    {
      "CODE_GRUP": "App", 
      "CODE_SNIPPET": "prfun", 
      "CODE": "Private Function @1()\r\n\r\nEnd Function", 
      "DISCRIPTION": "Private Function"
    }, 
    {
      "CODE_GRUP": "App", 
      "CODE_SNIPPET": "prsub", 
      "CODE": "Private Sub @1()\r\n\r\nEnd Sub", 
      "DISCRIPTION": "Private Sub"
    }, 
    {
      "CODE_GRUP": "App", 
      "CODE_SNIPPET": "pucon", 
      "CODE": "Public Const SH_NAME As String = \"SH_NAME\"", 
      "DISCRIPTION": "Public Const"
    }, 
    {
      "CODE_GRUP": "App", 
      "CODE_SNIPPET": "pufun", 
      "CODE": "Public Function @1()\r\n    Const PROCEDURE_NAME As String = \"@1\"\r\n    \r\nEnd Function", 
      "DISCRIPTION": "Public Function"
    }, 
    {
      "CODE_GRUP": "App", 
      "CODE_SNIPPET": "pusub", 
      "CODE": "Public Sub @1()\r\n    Const PROCEDURE_NAME As String = \"@1\"\r\n    \r\nEnd Sub", 
      "DISCRIPTION": "Public Sub"
    }, 
    {
      "CODE_GRUP": "App", 
      "CODE_SNIPPET": "ScrF", 
      "CODE": "Application.ScreenUpdating = False\r\nApplication.Calculation=xlCalculationManual", 
      "DISCRIPTION": "ScreenUpdating = False Calculation=xlCalculationManual"
    }, 
    {
      "CODE_GRUP": "App", 
      "CODE_SNIPPET": "ScrT", 
      "CODE": "Application.Calculation = xlCalculationAutomatic\r\nApplication.ScreenUpdating = True", 
      "DISCRIPTION": "Calculation = xlCalculationAutomatic  ScreenUpdating = True"
    }, 
    {
      "CODE_GRUP": "App", 
      "CODE_SNIPPET": "ThWb", 
      "CODE": "With ThisWorkbook.Worksheets(SHName)\r\n    \r\nEnd With", 
      "DISCRIPTION": "Создает With ThisWorkbook.Worksheets(SHName)"
    }, 
    {
      "CODE_GRUP": "App", 
      "CODE_SNIPPET": "Wth", 
      "CODE": "With @1\r\r\n \r\nEnd With", 
      "DISCRIPTION": "Создает With "
    }, 
    {
      "CODE_GRUP": "Custom", 
      "CODE_SNIPPET": "addCheckBox", 
      "CODE": "Private Sub addCheckBox(ByRef cellInsert As Range, ByRef cellLinked As Range, ByVal sCaption As String, Optional sNameSub As String = vbNullString, Optional sParametrs As String = vbNullString)\r\n    With ActiveSheet.CheckBoxes.Add(cellInsert.Left, cellInsert.Top, cellInsert.Width, cellInsert.Height)\r\n        .Characters.Text = sCaption\r\n        If sNameSub <> vbNullString Then\r\n            .Name = \"A_\" & cellInsert.Row & \"_\" & cellInsert.Column\r\n            If sParametrs <> vbNullString Then\r\n                .OnAction = \"'\" & sNameSub & \"\"\"\" & .Name & \"_\" & sParametrs & \"\"\"'\"\r\n            Else\r\n                .OnAction = \"'\" & sNameSub & \"'\"\r\n            End If\r\n        End If\r\n        .Select\r\n        With Selection\r\n            .Value = xlOff\r\n            .LinkedCell = cellLinked.Address\r\n            .Display3DShading = False\r\n        End With\r\n    End With\r\nEnd Sub", 
      "DISCRIPTION": "Создание CheckBox-сов в выбраном диапазоне, с привязкой макроса с параметром"
    }, 
    {
      "CODE_GRUP": "Custom", 
      "CODE_SNIPPET": "arr", 
      "CODE": "Dim arr         As Variant\r\narr = .Range(.Cells(1, 1), .Cells(1, 1)).Value2", 
      "DISCRIPTION": "Загрузка диапазона в массив"
    }, 
    {
      "CODE_GRUP": "Custom", 
      "CODE_SNIPPET": "arrDemens", 
      "CODE": "Public Function ArrDemens(ByRef arr As Variant) As Long\r\n    On Error Resume Next\r\n    ArrDemens = UBound(arr, 1)\r\n    If Err.Number <> 0 Then ArrDemens = -1\r\n    Err.Clear\r\nEnd Function", 
      "DISCRIPTION": "Проверка есть размерность массива"
    }, 
    {
      "CODE_GRUP": "Custom", 
      "CODE_SNIPPET": "arrFor", 
      "CODE": "Dim i           As Long\r\nDim iCount      As Long\r\niCount = UBound(arr, 1)\r\nFor i = 1 To iCount\r\n    \r\nNext i", 
      "DISCRIPTION": "Создать цикл по массву"
    }, 
    {
      "CODE_GRUP": "Custom", 
      "CODE_SNIPPET": "arrFor2", 
      "CODE": "Dim i               As Long\r\nDim iCount          As Long\r\nDim j               As Long\r\nDim jCount          As Long\r\niCount = UBound(arr, 1)\r\njCount = UBound(arr_2, 1)\r\nFor i = 1 To iCount\r\n    For j = 1 To jCount\r\n\r\n    Next j\r\nNext i", 
      "DISCRIPTION": "Создать цикл по2-м  массвам"
    }, 
    {
      "CODE_GRUP": "Custom", 
      "CODE_SNIPPET": "arrSort", 
      "CODE": "\r\n'=======================================================================================\r\n' Procedure : SortArray\r\n' Purpose   : Выполняет сортировку двумерного массива по возрастанию значений в указанном столбце.\r\n'             Сортировка выполняется методом \"пузырька\" (Bubble Sort) непосредственно\r\n'             в исходном массиве (in-place).\r\n'\r\n' Parameters:\r\n'   SourceArr   (ByRef Variant) - Ссылка на сортируемый двумерный массив.\r\n'                                 Поскольку аргумент передается ByRef, исходный массив\r\n'                                 будет изменен после вызова функции.\r\n'   ColumnIndex (ByVal Long)    - Индекс столбца, используемый в качестве ключа сортировки.\r\n'\r\n' Returns     : Variant - Возвращает отсортированный массив.\r\n'\r\n' Throws      : Error 13 (Type Mismatch) - Если входной аргумент SourceArr не является массивом.\r\n'               Error 9  (Subscript out of range) - Если индекс ColumnIndex выходит за границы\r\n'                                                   измерений массива.\r\n'=======================================================================================\r\nPublic Function SortArray(ByRef SourceArr As Variant, ByVal ColumnIndex As Long) As Variant\r\n    Dim i           As Long\r\n    Dim j           As Long\r\n    Dim LB1         As Long\r\n    Dim UB1         As Long\r\n    Dim LB2         As Long\r\n    Dim UB2         As Long\r\n    Dim IsSorted    As Boolean\r\n    Dim TempValue   As Variant\r\n\r\n    ' Проверка типа входных данных\r\n    If Not IsArray(SourceArr) Then\r\n        Err.Raise 13, \"SortArray\", \"Входной аргумент не является массивом\"\r\n    End If\r\n\r\n    ' Определение границ массива\r\n    LB1 = LBound(SourceArr, 1)\r\n    UB1 = UBound(SourceArr, 1)\r\n    LB2 = LBound(SourceArr, 2)\r\n    UB2 = UBound(SourceArr, 2)\r\n\r\n    ' Проверка корректности индекса столбца\r\n    If ColumnIndex < LB2 Or ColumnIndex > UB2 Then\r\n        Err.Raise 9, \"SortArray\", \"Указанный столбец выходит за границы массива\"\r\n    End If\r\n\r\n    ' Основной цикл алгоритма сортировки\r\n    Do\r\n        IsSorted = True\r\n        For i = LB1 To UB1 - 1\r\n            ' Сравнение элементов соседних строк в целевом столбце\r\n            If SourceArr(i, ColumnIndex) > SourceArr(i + 1, ColumnIndex) Then\r\n                \r\n                ' Перестановка строк массива\r\n                For j = LB2 To UB2\r\n                    TempValue = SourceArr(i, j)\r\n                    SourceArr(i, j) = SourceArr(i + 1, j)\r\n                    SourceArr(i + 1, j) = TempValue\r\n                Next j\r\n                IsSorted = False\r\n            End If\r\n        Next i\r\n    Loop Until IsSorted\r\n    SortArray = SourceArr\r\nEnd Function", 
      "DISCRIPTION": "Сортировка массива"
    }, 
    {
      "CODE_GRUP": "Custom", 
      "CODE_SNIPPET": "arrSort2DArray", 
      "clsSort2DArray.cls": "\n'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\n'* Module     : clsSort2DArray\n'* Purpose    : Класс для сортировки двумерных массивов VBA\n'* Algorithms : QuickSort (неустойчивый, in-place) и MergeSort (устойчивый)\n'*\n'* Version    : 3.0 (Refactored)\n'* License    : Apache License\n'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\n\n'==========================================================================================\n' ENUMERATIONS\n'==========================================================================================\n\nPublic Enum SortDataType\n    sdtString = 1\n    sdtNumber = 2\nEnd Enum\n\n'==========================================================================================\n' PRIVATE MEMBERS\n'==========================================================================================\n\nPrivate mCol        As Long\nPrivate mSortUp     As Boolean\nPrivate mArr        As Variant\nPrivate mDataType   As SortDataType\n\n'==========================================================================================\n' ERROR CONSTANTS\n'==========================================================================================\n\nPrivate Const ERR_EMPTY_ARRAY      As Long = vbObjectError + 513\nPrivate Const ERR_NOT_2D_ARRAY     As Long = vbObjectError + 514\nPrivate Const ERR_INVALID_COLUMN   As Long = vbObjectError + 515\nPrivate Const ERR_SINGLE_ROW       As Long = vbObjectError + 516\n\nPrivate Const ERR_MSG_EMPTY        As String = \"Array is empty or not initialized\"\nPrivate Const ERR_MSG_NOT_2D       As String = \"Two-dimensional array required\"\nPrivate Const ERR_MSG_INVALID_COL  As String = \"Column index out of range\"\n\n'==========================================================================================\n' PROPERTIES\n'==========================================================================================\n\nPublic Property Get ColumnSort() As Long\n    ColumnSort = mCol\nEnd Property\n\nPublic Property Get SortUp() As Boolean\n    SortUp = mSortUp\nEnd Property\n\nPublic Property Get ListArray() As Variant\n    ListArray = mArr\nEnd Property\n\nPublic Property Get CountColumns() As Long\n    If IsArrayAllocated(mArr) Then\n        CountColumns = UBound(mArr, 2) - LBound(mArr, 2) + 1\n    End If\nEnd Property\n\nPublic Property Get CountRows() As Long\n    If IsArrayAllocated(mArr) Then\n        CountRows = UBound(mArr, 1) - LBound(mArr, 1) + 1\n    End If\nEnd Property\n\nPublic Property Get DataType() As SortDataType\n    DataType = mDataType\nEnd Property\n\n'==========================================================================================\n' PUBLIC METHODS\n'==========================================================================================\n\n'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\n'* Method: SortQuick\n'* Purpose: Быстрая сортировка массива (алгоритм QuickSort)\n'*\n'* Parameters:\n'*   vArr       - Двумерный массив для сортировки\n'*   iCol       - Индекс столбца сортировки (по умолчанию - первый столбец)\n'*   bSortUp    - True = по возрастанию (по умолчанию), False = по убыванию\n'*   eDataType  - Тип данных: sdtString или sdtNumber\n'*\n'* Remarks:\n'*   - In-place сортировка (без дополнительной памяти)\n'*   - Неустойчивый алгоритм (может менять порядок равных элементов)\n'*   - O(N log N) средняя сложность, O(N^2) худший случай\n'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\n\nPublic Sub SortQuick(ByVal vArr As Variant, _\n                     Optional ByVal iCol As Long = -1, _\n                     Optional ByVal bSortUp As Boolean = True, _\n                     Optional ByVal eDataType As SortDataType = sdtString)\n    \n    ' Валидация и инициализация\n    Call ValidateArray(vArr, iCol)\n    \n    mArr = vArr\n    mCol = iCol\n    mSortUp = bSortUp\n    mDataType = eDataType\n    \n    ' Инициализация генератора случайных чисел для медианы трёх\n    Call Randomize\n    \n    ' Проверка на тривиальный случай (1 строка)\n    If UBound(mArr, 1) - LBound(mArr, 1) < 1 Then Exit Sub\n    \n    Call QuickSortInternal(mArr, LBound(mArr, 1), UBound(mArr, 1), mCol, mSortUp, mDataType)\n    \nEnd Sub\n\n'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\n'* Method: SortMerge\n'* Purpose: Устойчивая сортировка массива (алгоритм MergeSort)\n'*\n'* Parameters:\n'*   vArr       - Двумерный массив для сортировки\n'*   iCol       - Индекс столбца сортировки (по умолчанию - первый столбец)\n'*   bSortUp    - True = по возрастанию (по умолчанию), False = по убыванию\n'*   eDataType  - Тип данных: sdtString или sdtNumber\n'*\n'* Remarks:\n'*   - Устойчивый алгоритм (сохраняет порядок равных элементов)\n'*   - Требует O(N) дополнительной памяти\n'*   - O(N log N) гарантированная сложность\n'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\n\nPublic Sub SortMerge(ByVal vArr As Variant, _\n                     Optional ByVal iCol As Long = -1, _\n                     Optional ByVal bSortUp As Boolean = True, _\n                     Optional ByVal eDataType As SortDataType = sdtString)\n    \n    ' Валидация и инициализация\n    Call ValidateArray(vArr, iCol)\n    \n    mArr = vArr\n    mCol = iCol\n    mSortUp = bSortUp\n    mDataType = eDataType\n    \n    ' Проверка на тривиальный случай (1 строка)\n    If UBound(mArr, 1) - LBound(mArr, 1) < 1 Then Exit Sub\n    \n    Call MergeSortInternal(mArr, LBound(mArr, 1), UBound(mArr, 1), mCol, mSortUp, mDataType)\n    \nEnd Sub\n\n'==========================================================================================\n' PRIVATE METHODS - VALIDATION\n'==========================================================================================\n\nPrivate Sub ValidateArray(ByRef vArr As Variant, ByRef iCol As Long)\n    ' Проверка, что передан массив\n    If Not IsArray(vArr) Then\n        Err.Raise ERR_NOT_2D_ARRAY, \"clsSort2DArray.ValidateArray\", ERR_MSG_NOT_2D\n    End If\n    \n    ' Проверка на пустой/неинициализированный массив\n    If Not IsArrayAllocated(vArr) Then\n        Err.Raise ERR_EMPTY_ARRAY, \"clsSort2DArray.ValidateArray\", ERR_MSG_EMPTY\n    End If\n    \n    ' Проверка размерности (должен быть 2D)\n    If ArrayDimensions(vArr) <> 2 Then\n        Err.Raise ERR_NOT_2D_ARRAY, \"clsSort2DArray.ValidateArray\", ERR_MSG_NOT_2D\n    End If\n    \n    ' Определение столбца сортировки\n    If iCol < 0 Then\n        iCol = LBound(vArr, 2)\n    End If\n    \n    ' Проверка корректности индекса столбца\n    If iCol < LBound(vArr, 2) Or iCol > UBound(vArr, 2) Then\n        Err.Raise ERR_INVALID_COLUMN, \"clsSort2DArray.ValidateArray\", ERR_MSG_INVALID_COL\n    End If\n    \nEnd Sub\n\nPrivate Function IsArrayAllocated(ByRef vArr As Variant) As Boolean\n    On Error Resume Next\n    Dim i As Long\n    i = UBound(vArr, 1)\n    IsArrayAllocated = Err.Number = 0\nEnd Function\n\nPrivate Function ArrayDimensions(ByRef vArr As Variant) As Integer\n    On Error Resume Next\n    \n    Dim i As Integer\n    i = 1\n    Do\n        i = i + 1\n    Loop While UBound(vArr, i)\n    \n    ArrayDimensions = i - 1\n    Err.Clear\n    On Error GoTo 0\nEnd Function\n\n'==========================================================================================\n' PRIVATE METHODS - QUICKSORT\n'==========================================================================================\n\nPrivate Sub QuickSortInternal(ByRef pvarArray As Variant, _\n                              ByVal lngLeft As Long, _\n                              ByVal lngRight As Long, _\n                              ByVal iCol As Long, _\n                              ByVal bSortAsc As Boolean, _\n                              ByVal eDataType As SortDataType)\n    \n    Dim lngFirst        As Long\n    Dim lngLast         As Long\n    Dim varPivot        As Variant\n    Dim varSwap         As Variant\n    Dim j               As Long\n    Dim lngPivotIndex   As Long\n    \n    lngFirst = lngLeft\n    lngLast = lngRight\n    \n    ' Выбор опорного элемента: медиана трёх\n    lngPivotIndex = GetMedianOfThree(pvarArray, lngLeft, lngRight, iCol, eDataType)\n    varPivot = GetComparableValue(pvarArray(lngPivotIndex, iCol), eDataType)\n    \n    Do\n        ' Поиск элемента слева, который должен быть справа от опорного\n        Do While lngFirst < lngRight\n            If ShouldSwap(varPivot, pvarArray(lngFirst, iCol), eDataType, bSortAsc) Then\n                Exit Do\n            End If\n            lngFirst = lngFirst + 1\n        Loop\n        \n        ' Поиск элемента справа, который должен быть слева от опорного\n        Do While lngLast > lngLeft\n            If ShouldSwap(pvarArray(lngLast, iCol), varPivot, eDataType, bSortAsc) Then\n                Exit Do\n            End If\n            lngLast = lngLast - 1\n        Loop\n        \n        ' Обмен строк\n        If lngFirst <= lngLast Then\n            Call SwapRows(pvarArray, lngFirst, lngLast)\n            lngFirst = lngFirst + 1\n            lngLast = lngLast - 1\n        End If\n        \n    Loop Until lngFirst > lngLast\n    \n    ' Рекурсивный вызов (оптимизация хвостовой рекурсии)\n    If (lngLast - lngLeft) < (lngRight - lngFirst) Then\n        If lngLeft < lngLast Then Call QuickSortInternal(pvarArray, lngLeft, lngLast, iCol, bSortAsc, eDataType)\n        If lngFirst < lngRight Then Call QuickSortInternal(pvarArray, lngFirst, lngRight, iCol, bSortAsc, eDataType)\n    Else\n        If lngFirst < lngRight Then Call QuickSortInternal(pvarArray, lngFirst, lngRight, iCol, bSortAsc, eDataType)\n        If lngLeft < lngLast Then Call QuickSortInternal(pvarArray, lngLeft, lngLast, iCol, bSortAsc, eDataType)\n    End If\n    \nEnd Sub\n\nPrivate Function GetMedianOfThree(ByRef pvarArray As Variant, _\n                                   ByVal lngLeft As Long, _\n                                   ByVal lngRight As Long, _\n                                   ByVal iCol As Long, _\n                                   ByVal eDataType As SortDataType) As Long\n    \n    Dim lngCount    As Long\n    Dim a           As Long\n    Dim b           As Long\n    Dim c           As Long\n    Dim vA          As Variant\n    Dim vB          As Variant\n    Dim vC          As Variant\n    \n    lngCount = lngRight - lngLeft + 1\n    \n    ' Три случайных индекса\n    a = Int(lngCount * Rnd) + lngLeft\n    b = Int(lngCount * Rnd) + lngLeft\n    c = Int(lngCount * Rnd) + lngLeft\n    \n    ' Получение сравниваемых значений\n    vA = GetComparableValue(pvarArray(a, iCol), eDataType)\n    vB = GetComparableValue(pvarArray(b, iCol), eDataType)\n    vC = GetComparableValue(pvarArray(c, iCol), eDataType)\n    \n    ' Определение медианы\n    If (vA <= vB And vB <= vC) Or (vC <= vB And vB <= vA) Then\n        GetMedianOfThree = b\n    ElseIf (vB <= vA And vA <= vC) Or (vC <= vA And vA <= vB) Then\n        GetMedianOfThree = a\n    Else\n        GetMedianOfThree = c\n    End If\n    \nEnd Function\n\n'==========================================================================================\n' PRIVATE METHODS - MERGESORT\n'==========================================================================================\n\nPrivate Sub MergeSortInternal(ByRef pvarArray As Variant, _\n                              ByVal lngLeft As Long, _\n                              ByVal lngRight As Long, _\n                              ByVal iCol As Long, _\n                              ByVal bSortAsc As Boolean, _\n                              ByVal eDataType As SortDataType)\n    \n    Dim lngMid As Long\n    \n    If lngLeft < lngRight Then\n        lngMid = (lngLeft + lngRight) \\ 2\n        \n        Call MergeSortInternal(pvarArray, lngLeft, lngMid, iCol, bSortAsc, eDataType)\n        Call MergeSortInternal(pvarArray, lngMid + 1, lngRight, iCol, bSortAsc, eDataType)\n        \n        Call MergeArrays(pvarArray, lngLeft, lngMid, lngRight, iCol, bSortAsc, eDataType)\n    End If\n    \nEnd Sub\n\nPrivate Sub MergeArrays(ByRef pvarArray As Variant, _\n                        ByVal lngLeft As Long, _\n                        ByVal lngMid As Long, _\n                        ByVal lngRight As Long, _\n                        ByVal iCol As Long, _\n                        ByVal bSortAsc As Boolean, _\n                        ByVal eDataType As SortDataType)\n    \n    Dim i           As Long\n    Dim j           As Long\n    Dim k           As Long\n    Dim n1          As Long\n    Dim n2          As Long\n    Dim lCol        As Long\n    Dim uCol        As Long\n    Dim c           As Long\n    Dim LeftArr()   As Variant\n    Dim RightArr()  As Variant\n    \n    n1 = lngMid - lngLeft + 1\n    n2 = lngRight - lngMid\n    \n    lCol = LBound(pvarArray, 2)\n    uCol = UBound(pvarArray, 2)\n    \n    ' Создание временных массивов\n    ReDim LeftArr(1 To n1, lCol To uCol)\n    ReDim RightArr(1 To n2, lCol To uCol)\n    \n    ' Копирование данных во временные массивы\n    For i = 1 To n1\n        For c = lCol To uCol\n            LeftArr(i, c) = pvarArray(lngLeft + i - 1, c)\n        Next c\n    Next i\n    \n    For j = 1 To n2\n        For c = lCol To uCol\n            RightArr(j, c) = pvarArray(lngMid + j, c)\n        Next c\n    Next j\n    \n    ' Слияние\n    i = 1\n    j = 1\n    k = lngLeft\n    \n    Do While i <= n1 And j <= n2\n        If ShouldTakeLeft(LeftArr(i, iCol), RightArr(j, iCol), eDataType, bSortAsc) Then\n            Call CopyRowToDest(LeftArr, i, pvarArray, k, lCol, uCol)\n            i = i + 1\n        Else\n            Call CopyRowToDest(RightArr, j, pvarArray, k, lCol, uCol)\n            j = j + 1\n        End If\n        k = k + 1\n    Loop\n    \n    ' Копирование оставшихся элементов\n    Do While i <= n1\n        Call CopyRowToDest(LeftArr, i, pvarArray, k, lCol, uCol)\n        i = i + 1\n        k = k + 1\n    Loop\n    \n    Do While j <= n2\n        Call CopyRowToDest(RightArr, j, pvarArray, k, lCol, uCol)\n        j = j + 1\n        k = k + 1\n    Loop\n    \nEnd Sub\n\n'==========================================================================================\n' PRIVATE METHODS - HELPERS\n'==========================================================================================\n\nPrivate Function GetComparableValue(ByVal vVal As Variant, ByVal eType As SortDataType) As Variant\n    On Error GoTo ErrHandler\n    \n    If eType = sdtNumber Then\n        If IsNumeric(vVal) Then\n            GetComparableValue = CDbl(vVal)\n        Else\n            GetComparableValue = 0\n        End If\n    Else\n        GetComparableValue = CStr(vVal)\n    End If\n    Exit Function\n    \nErrHandler:\n    GetComparableValue = IIf(eType = sdtNumber, 0, vbNullString)\nEnd Function\n\nPrivate Function ShouldSwap(ByVal vLeft As Variant, _\n                            ByVal vRight As Variant, _\n                            ByVal eDataType As SortDataType, _\n                            ByVal bSortAsc As Boolean) As Boolean\n    ' Возвращает True, если элементы нужно поменять местами\n    Dim vLeftVal    As Variant\n    Dim vRightVal   As Variant\n    \n    vLeftVal = GetComparableValue(vLeft, eDataType)\n    vRightVal = GetComparableValue(vRight, eDataType)\n    \n    If bSortAsc Then\n        ShouldSwap = vLeftVal < vRightVal\n    Else\n        ShouldSwap = vLeftVal > vRightVal\n    End If\nEnd Function\n\nPrivate Function ShouldTakeLeft(ByVal vLeft As Variant, _\n                                ByVal vRight As Variant, _\n                                ByVal eDataType As SortDataType, _\n                                ByVal bSortAsc As Boolean) As Boolean\n    ' Для MergeSort: возвращает True, если нужно взять элемент из левого массива\n    Dim vLeftVal    As Variant\n    Dim vRightVal   As Variant\n    \n    vLeftVal = GetComparableValue(vLeft, eDataType)\n    vRightVal = GetComparableValue(vRight, eDataType)\n    \n    If bSortAsc Then\n        ShouldTakeLeft = vLeftVal <= vRightVal\n    Else\n        ShouldTakeLeft = vLeftVal >= vRightVal\n    End If\nEnd Function\n\nPrivate Sub SwapRows(ByRef pvarArray As Variant, _\n                     ByVal lngRow1 As Long, _\n                     ByVal lngRow2 As Long)\n    Dim c           As Long\n    Dim varSwap     As Variant\n    Dim lCol        As Long\n    Dim uCol        As Long\n    \n    lCol = LBound(pvarArray, 2)\n    uCol = UBound(pvarArray, 2)\n    \n    For c = lCol To uCol\n        varSwap = pvarArray(lngRow1, c)\n        pvarArray(lngRow1, c) = pvarArray(lngRow2, c)\n        pvarArray(lngRow2, c) = varSwap\n    Next c\nEnd Sub\n\nPrivate Sub CopyRowToDest(ByRef srcArr As Variant, _\n                          ByVal srcRow As Long, _\n                          ByRef destArr As Variant, _\n                          ByVal destRow As Long, _\n                          ByVal lCol As Long, _\n                          ByVal uCol As Long)\n    Dim c As Long\n    \n    For c = lCol To uCol\n        destArr(destRow, c) = srcArr(srcRow, c)\n    Next c\nEnd Sub", 
      "CODE": "    Dim objSort     As clsSort2DArray\r\n    Set objSort = New clsSort2DArray\r\n    With objSort\r\n        Call .SortMerge(pvarArray, iCol, True, sdtNumber)\r\n        sortArray2D = .ListArray\r\n    End With\r\n    Set objSort = Nothing", 
      "DISCRIPTION": "Сортировка двухмерного массива создает класс"
    }, 
    {
      "CODE_GRUP": "Custom", 
      "CODE_SNIPPET": "arrTo2D", 
      "CODE": "Public Function arrTo2D(ByRef arr As Variant) As Variant\r\n    If arrIs2D(arr) Then\r\n        arrTo2D = arr\r\n    Else\r\n        Dim i       As Long\r\n        Dim iCount  As Long\r\n        iCount = UBound(arr, 1)\r\n        ReDim newArr(1 To 1, 1 To iCount)\r\n        For i = 1 To iCount\r\n            newArr(1, i) = arr(i)\r\n        Next i\r\n        arrTo2D = newArr\r\n    End If\r\nEnd Function\r\n\r\nPrivate Function arrIs2D(ByRef arr As Variant) As Boolean\r\n    On Error Resume Next\r\n    arrIs2D = True\r\n    Dim i           As Byte\r\n    i = UBound(arr, 2)\r\n    If Err.Number <> 0 Then arrIs2D = False\r\nEnd Function", 
      "DISCRIPTION": "Перевод одномерного масива в двухмерный"
    }, 
    {
      "CODE_GRUP": "Custom", 
      "CODE_SNIPPET": "arrTranspose", 
      "CODE": "Public Function TransposeArray(ByVal sourceArray As Variant) As Variant\r\n    ' Функция для транспонирования двумерного массива\r\n    On Error GoTo ErrorHandler\r\n\r\n    ' 1. Проверка входных данных\r\n    If Not IsArray(sourceArray) Then\r\n        Err.Raise vbObjectError + 1, \"TransposeArray\", \"Входной параметр не является массивом.\"\r\n    End If\r\n\r\n    Dim lowerRow    As Long\r\n    Dim upperRow    As Long\r\n    Dim lowerCol    As Long\r\n    Dim upperCol    As Long\r\n\r\n    ' 2. Определение границ исходного массива\r\n    lowerRow = LBound(sourceArray, 1)\r\n    upperRow = UBound(sourceArray, 1)\r\n    lowerCol = LBound(sourceArray, 2)\r\n    upperCol = UBound(sourceArray, 2)\r\n\r\n    ' 3. Инициализация результирующего массива с swapped размерами\r\n    Dim resultArray As Variant\r\n    ReDim resultArray(lowerCol To upperCol, lowerRow To upperRow)\r\n\r\n    Dim i           As Long\r\n    Dim j           As Long\r\n\r\n    ' 4. Цикл транспонирования\r\n    For i = lowerCol To upperCol\r\n        For j = lowerRow To upperRow\r\n            resultArray(i, j) = sourceArray(j, i)\r\n        Next j\r\n    Next i\r\n\r\n    ' 5. Возврат результата\r\n    TransposeArray = resultArray\r\n    Exit Function\r\n\r\nErrorHandler:\r\n    ' Логирование ошибки или возврат Empty в зависимости от требований\r\n    TransposeArray = Empty\r\nEnd Function", 
      "DISCRIPTION": " Пользовательская функция для транспонирования массива"
    }, 
    {
      "CODE_GRUP": "Custom", 
      "CODE_SNIPPET": "arrUniqueValuesFrom", 
      "CODE": "Public Function UniqueValuesFromArray(ByVal arr As Variant, ByVal col As Long) As Variant\r\n    ' Функция возвращает двумерный массив уникальных строк на основе уникальности значения в столбце col.\r\n    ' Если входной массив некорректен или уникальные значения не найдены, возвращается Empty.\r\n    \r\n\r\n    ' --- 1. Проверка входных данных и определение границ ---\r\n    If Not IsArray(arr) Then\r\n        UniqueValuesFromArray = Empty\r\n        Exit Function\r\n    End If\r\n    \r\n    Dim iColCount As Long\r\n    Dim iLBoundRow As Long\r\n    Dim iUBoundRow As Long\r\n    \r\n    On Error Resume Next\r\n    iLBoundRow = LBound(arr, 1)\r\n    iUBoundRow = UBound(arr, 1)\r\n    iColCount = UBound(arr, 2)\r\n    \r\n    If Err.Number <> 0 Then\r\n        ' Ошибка при получении границ (возможно, массив не двумерный)\r\n        On Error GoTo 0\r\n        UniqueValuesFromArray = Empty\r\n        Exit Function\r\n    End If\r\n    On Error GoTo 0\r\n    \r\n    ' Проверка, что номер столбца находится в допустимых пределах\r\n    ' Примечание: предполагаем, что массив 1-based, как диапазоны Excel\r\n    If col < LBound(arr, 2) Or col > iColCount Then\r\n        UniqueValuesFromArray = Empty\r\n        Exit Function\r\n    End If\r\n\r\n    ' --- 2. Сбор уникальных значений ---\r\n    Dim i As Long\r\n    Dim j As Long\r\n    \r\n    Dim coll As Collection\r\n    Dim txtKey As String\r\n    Dim txtItem As String\r\n    \r\n    Dim newArr() As Variant\r\n    Dim arrItem As Variant\r\n    \r\n    Set coll = New Collection\r\n    \r\n    For i = iLBoundRow To iUBoundRow\r\n        ' Формируем ключ для проверки уникальности (используем Trim и CStr для надежности)\r\n        txtKey = Trim(CStr(arr(i, col)))\r\n        \r\n        ' Формируем строку со всеми значениями текущей строки\r\n        txtItem = vbNullString\r\n        For j = 1 To iColCount\r\n            txtItem = txtItem & CStr(arr(i, j)) & \"||\"\r\n        Next j\r\n        \r\n        ' Пытаемся добавить элемент. Ошибка игнорируется (означает дубликат ключа)\r\n        On Error Resume Next\r\n        coll.Add txtItem, txtKey\r\n        On Error GoTo 0\r\n    Next i\r\n    \r\n    ' --- 3. Формирование выходного массива ---\r\n    If coll.Count = 0 Then\r\n        UniqueValuesFromArray = Empty\r\n        Exit Function\r\n    End If\r\n    \r\n    ReDim newArr(1 To coll.Count, 1 To iColCount)\r\n    \r\n    For i = 1 To coll.Count\r\n        arrItem = VBA.Split(coll(i), \"||\")\r\n        \r\n        ' Заполняем выходной массив (Split возвращает 0-based массив)\r\n        For j = 1 To iColCount\r\n            ' Защита от выхода за пределы массива (на всякий случай)\r\n            If j - 1 <= UBound(arrItem) Then\r\n                newArr(i, j) = arrItem(j - 1)\r\n            End If\r\n        Next j\r\n    Next i\r\n    \r\n    UniqueValuesFromArray = newArr\r\nEnd Function", 
      "DISCRIPTION": "Получить уникальные значения из массива"
    }, 
    {
      "CODE_GRUP": "Custom", 
      "CODE_SNIPPET": "BlendColor", 
      "CODE": "Public Function BlendColor(ByVal colorFirst As Long, colorSecond As Long, blendProcent As Single) As Long\r\n    Dim r1 As Byte, g1 As Byte, b1 As Byte\r\n    Dim r2 As Integer, g2 As Integer, b2 As Integer\r\n    Dim r As Byte, g As Byte, b As Byte\r\n\r\n    ' Extract BGR components from the first color (VBA uses BGR format)\r\n    r1 = colorFirst Mod 256\r\n    g1 = (colorFirst \\ 256) Mod 256\r\n    b1 = (colorFirst \\ 65536) Mod 256\r\n\r\n    ' Extract BGR components from the second color (VBA uses BGR format)\r\n    r2 = colorSecond Mod 256\r\n    g2 = (colorSecond \\ 256) Mod 256\r\n    b2 = (colorSecond \\ 65536) Mod 256\r\n\r\n    ' Blend the colors\r\n    r = r1 + (r2 - r1) * blendProcent\r\n    g = g1 + (g2 - g1) * blendProcent\r\n    b = b1 + (b2 - b1) * blendProcent\r\n\r\n    ' Return the blended color\r\n    BlendColor = RGB(r, g, b)\r\nEnd Function", 
      "DISCRIPTION": "Смешивание двух цветов"
    }, 
    {
      "CODE_GRUP": "Custom", 
      "CODE_SNIPPET": "Clear", 
      "CODE": ".Range(.Cells(1, 1), .Cells(1, 1)).ClearContents", 
      "DISCRIPTION": "Очистить диапазон от значений"
    }, 
    {
      "CODE_GRUP": "Custom", 
      "CODE_SNIPPET": "delAllFilesInPath", 
      "CODE": "Public Sub deleteAllFilesInPath(ByVal sPath As String)\r\n    Dim AllFilesMask As String    'шаблон пути всех файлов\r\n    AllFilesMask = sPath & \"*.*\"\r\n    'проверяем наличие файлов, иначе при удалении возникнет ошибка\r\n    If VBA.Len(Dir(AllFilesMask)) > 0 Then\r\n        Kill AllFilesMask\r\n    End If\r\nEnd Sub", 
      "DISCRIPTION": "Удалить все файлы в папке"
    }, 
    {
      "CODE_GRUP": "Custom", 
      "CODE_SNIPPET": "extractAllFilesFromZip", 
      "CODE": "Private Sub extractAllFilesFromZip(ByVal sPathFiles As String, ByVal sPathZip As String)\r\n    '\"C:\\Documents\"            - папка для извлечения файлов из архива\r\n    '\"C:\\Documents\\VBAZip.zip\" - имя ZIP-архива, из которого необходимо извлечь файлы\r\n    If Not FileHave(sPathFiles) Then Call MkDir(sPathFiles)\r\n    With CreateObject(\"Shell.Application\")\r\n        .Namespace((sPathFiles)).CopyHere .Namespace((sPathZip)).Items\r\n    End With\r\nEnd Sub", 
      "DISCRIPTION": "Извлечь файлы из архива"
    }, 
    {
      "CODE_GRUP": "Custom", 
      "CODE_SNIPPET": "FileDialog", 
      "CODE": "Public Function fileDialogFun(ByVal sPath As String, _\r\n        ByRef bMultiSelect As Boolean, _\r\n        Optional sExpansion As String = \"*.xlsm;*.xlsb;*.xlsx\") As String()\r\n\r\n    If sPath = vbNullString Or Not (Dir(sPath, vbDirectory) <> vbNullString) Then sPath = ThisWorkbook.Path\r\n\r\n    Dim oFd         As FileDialog\r\n    Set oFd = Application.FileDialog(msoFileDialogFilePicker)\r\n    With oFd\r\n        .AllowMultiSelect = bMultiSelect\r\n        'заголовок окна диалога\r\n        .Title = \"Выбрать файлы:\"\r\n        'очищаем установленные ранее типы файлов\r\n        .Filters.Clear\r\n        'устанавливаем возможность выбора только файлов Excel\r\n        .Filters.Add \"Microsoft Excel Files\", sExpansion, 1\r\n        'назначаем папку отображения и имя файла по умолчанию\r\n        .InitialFileName = sPath\r\n        'вид диалогового окна(доступно 9 вариантов)\r\n        .InitialView = msoFileDialogViewDetails\r\n        If .Show = 0 Then\r\n            Call MsgBox(\"Не выбрано ни одного файла!\", vbCritical, \"Выбор файлов:\")\r\n            Exit Function\r\n        End If\r\n        Dim iCount  As Integer\r\n        Dim i       As Integer\r\n        iCount = .SelectedItems.Count\r\n        'ReDim arr(1 To iCount) As String\r\n        ReDim arr(1 To iCount, 1 To 1) As String\r\n        For i = 1 To iCount\r\n            'arr(i) = VBA.CStr(.SelectedItems.Item(i))\r\n            arr(i, 1) = VBA.CStr(.SelectedItems.Item(i))\r\n        Next\r\n    End With\r\n    fileDialogFun = arr\r\n\r\n    'Для процедуры\r\n    'If (Not (Not (v))) = 0 Then Exit Sub\r\nEnd Function", 
      "DISCRIPTION": "Выбор файлов из папки"
    }, 
    {
      "CODE_GRUP": "Custom", 
      "CODE_SNIPPET": "FileHave", 
      "CODE": "Public Function FileHave(ByVal Path As String, ByVal fileAttribute As VbFileAttribute) As Boolean\r\n    Dim fso         As Object\r\n\r\n    ' Проверка на пустоту\r\n    If Path = vbNullString Then Exit Function\r\n    ' Создаем объект FileSystemObject\r\n    Set fso = CreateObject(\"Scripting.FileSystemObject\")\r\n    ' В зависимости от значения параметра IsFolder выбираем метод проверки\r\n    Select Case fileAttribute\r\n        Case VbFileAttribute.vbDirectory\r\n            ' Ищем папку\r\n            FileHave = fso.FolderExists(Path)\r\n        Case VbFileAttribute.vbNormal\r\n            ' Ищем файл\r\n            FileHave = fso.FileExists(Path)\r\n    End Select\r\n    ' Освобождаем память\r\n    Set fso = Nothing\r\nEnd Function", 
      "DISCRIPTION": "Проверка существования файла"
    }, 
    {
      "CODE_GRUP": "Custom", 
      "CODE_SNIPPET": "fileIsBusy", 
      "CODE": "Public Function fileIsBusy(ByVal File As String) As Boolean\r\n    Dim FN As Integer\r\n    FN = FreeFile\r\n    On Error Resume Next\r\n    Open File For Random Access Write Lock Write As #FN\r\n    Close #FN\r\n    fileIsBusy = (Err <> 0)\r\nEnd Function", 
      "DISCRIPTION": "Проверка открыта ли книга на другом комьютере"
    }, 
    {
      "CODE_GRUP": "Custom", 
      "CODE_SNIPPET": "getLetterByNomer", 
      "CODE": "Public Function getLetterByNomer(ByVal iCol As Integer) As String\r\n    getLetterByNomer = VBA.Split(Cells(1, iCol).Address(True, False), \"$\")(0)\r\nEnd Function", 
      "DISCRIPTION": "Получение буквы столбца по его номеру"
    }, 
    {
      "CODE_GRUP": "Custom", 
      "CODE_SNIPPET": "GetListFiles", 
      "CODE": "Private Function GetListFiles(sFolder As String) As String()\r\n    Dim a()         As String\r\n    Dim FSO         As Object\r\n    Dim fld         As Object\r\n    Dim fl          As Variant\r\n    Dim i           As Long\r\n    Set FSO = CreateObject(\"Scripting.FileSystemObject\")\r\n    Set fld = FSO.GetFolder(sFolder)\r\n    ReDim Preserve a(1 To fld.Files.Count)\r\n    i = 1\r\n    For Each fl In fld.Files\r\n        a(i) = fl.Name\r\n        i = i + 1\r\n    Next\r\n    GetListFiles = a\r\n    Set fld = Nothin: Set FSO = Nothing\r\nEnd Function", 
      "DISCRIPTION": "Список файлов в папке в массиве"
    }, 
    {
      "CODE_GRUP": "Custom", 
      "CODE_SNIPPET": "getPath", 
      "CODE": "Public Function getPath(ByVal sTitle As String, ByVal sPath As String) As String\r\n    On Error GoTo OptB_UsePatch_Change_Err\r\n    If sPath = vbNullString Or Not (Dir(sPath, vbDirectory) <> vbNullString) Then sPath = ThisWorkbook.Path\r\n    Dim sGetFolder  As String\r\n    With Application.FileDialog(msoFileDialogFolderPicker)        ' вывод диалогового окна\r\n        .ButtonName = \"Выбрать\": .Title = sTitle: .InitialFileName = sPath\r\n        If .Show <> -1 Then\r\n            getPath = sPath\r\n            Exit Function    ' если пользователь отказался от выбора папки\r\n        End If\r\n        sGetFolder = .SelectedItems(1)\r\n    End With\r\n    getPath = sGetFolder & Application.PathSeparator\r\n    Exit Function\r\nOptB_UsePatch_Change_Err:\r\n    MsgBox Err.Description, vbExclamation + vbOKOnly, \"Ошибка:\"\r\nEnd Function", 
      "DISCRIPTION": "Получение пути к папке"
    }, 
    {
      "CODE_GRUP": "Custom", 
      "CODE_SNIPPET": "GetSheetNameCloseBook", 
      "CODE": "Private Function GetSheetNameCloseBook(ByVal FulNameFile As String, _\r\n                                       Optional sFileExists As String = \"*.xls, *.xlsx, *.xlsm, *.xlsb\") As String()\r\n\r\n    'FulNameFile - текстовы формат, полное название файла\r\n\r\n    Dim TN     As String\r\n    Dim Cnn    As Object    'ADODB.Connection\r\n    Dim rS     As Object    'ADODB.Recordset\r\n    Dim n      As Integer\r\n    Dim arrName() As String\r\n\r\n    Const adSchemaTables As Byte = 20\r\n\r\n    On Error Resume Next\r\n\r\n    Set Cnn = CreateObject(\"ADODB.Connection\")\r\n    Set rS = CreateObject(\"ADODB.Recordset\")\r\n\r\n    Cnn.Open \"Driver={Microsoft Excel Driver (\" & sFileExists & \")};DBQ=\" & FulNameFile & \";ReadOnly=1\"\r\n    Set rS = Cnn.OpenSchema(adSchemaTables)\r\n    n = 0\r\n    Do While Not rS.EOF\r\n        TN = rS(\"TABLE_NAME\")\r\n        If Left(TN, 1) = \"'\" Then TN = Mid(TN, 2)\r\n\r\n        If Len(TN) < InStr(1, TN, \"$\") + 2 Then\r\n            TN = Left(TN, InStr(1, TN, \"$\") - 1)\r\n            TN = Replace(TN, \"#\", \".\")\r\n            ReDim Preserve arrName(0 To n)\r\n            arrName(n) = TN\r\n            n = n + 1\r\n        End If\r\n        rS.MoveNext\r\n    Loop\r\n    rS.Close\r\n    Set Cnn = Nothing\r\n    Set rS = Nothing\r\n    GetSheetNameCloseBook = arrName\r\nEnd Function", 
      "DISCRIPTION": "Получить названия листов из закрытой книги Excel"
    }, 
    {
      "CODE_GRUP": "Custom", 
      "CODE_SNIPPET": "GetUniqueValueFromRange", 
      "CODE": "Public Function GetUniqueValueFromRange(ByVal arr As Variant) As String()\r\n    Dim vItem, li As Long\r\n    Dim avArr() As String\r\n    li = 0\r\n    With New Collection\r\n        On Error Resume Next\r\n        For Each vItem In arr\r\n            If Len(CStr(vItem)) Then\r\n                .Add vItem, CStr(vItem)\r\n                If Err = 0 Then\r\n                    ReDim Preserve avArr(0 To li)\r\n                    avArr(li) = CStr(vItem)\r\n                    li = li + 1\r\n                Else\r\n                    Err.Clear\r\n                End If\r\n            End If\r\n        Next\r\n    End With\r\n\r\n    If li = 0 Then\r\n        ReDim Preserve avArr(0 To 0)\r\n        avArr(0) = 0\r\n    End If\r\n    GetUniqueValueFromRange = avArr\r\nEnd Function", 
      "DISCRIPTION": "Получить уникальные значения из диапазона"
    }, 
    {
      "CODE_GRUP": "Custom", 
      "CODE_SNIPPET": "hash", 
      "CODE": "Public Function MD5(ByVal sIn As String, Optional bB64 As Boolean = 0) As String\r\n    'Set a reference to mscorlib 4.0 64-bit\r\n    'Check that Net Framework 3.5 (includes .Net 2 and .Net 3 is installed in windows\r\n    'and not just Net Advanced Services\r\n        \r\n    'Test with empty string input:\r\n    'Hex:   d41d8cd98f00...etc\r\n    'Base-64: 1B2M2Y8Asg...etc\r\n        \r\n    Dim oT As Object, oMD5 As Object\r\n    Dim TextToHash() As Byte\r\n    Dim bytes() As Byte\r\n        \r\n    Set oT = CreateObject(\"System.Text.UTF8Encoding\")\r\n    Set oMD5 = CreateObject(\"System.Security.Cryptography.MD5CryptoServiceProvider\")\r\n \r\n    TextToHash = oT.Getbytes_4(sIn)\r\n    bytes = oMD5.ComputeHash_2((TextToHash))\r\n \r\n    If bB64 = True Then\r\n       MD5 = ConvToBase64String(bytes)\r\n    Else\r\n       MD5 = ConvToHexString(bytes)\r\n    End If\r\n        \r\n    Set oT = Nothing\r\n    Set oMD5 = Nothing\r\n\r\nEnd Function\r\n\r\nPublic Function SHA1(sIn As String, Optional bB64 As Boolean = 0) As String\r\n    'Set a reference to mscorlib 4.0 64-bit\r\n    'Check that Net Framework 3.5 (includes .Net 2 and .Net 3 is installed in windows\r\n    'and not just Net Advanced Services\r\n   \r\n   'Test with empty string input:\r\n    '40 Hex:   da39a3ee5e6...etc\r\n    '28 Base-64:   2jmj7l5rSw0yVb...etc\r\n    \r\n    Dim oT As Object, oSHA1 As Object\r\n    Dim TextToHash() As Byte\r\n    Dim bytes() As Byte\r\n            \r\n    Set oT = CreateObject(\"System.Text.UTF8Encoding\")\r\n    Set oSHA1 = CreateObject(\"System.Security.Cryptography.SHA1Managed\")\r\n    \r\n    TextToHash = oT.Getbytes_4(sIn)\r\n    bytes = oSHA1.ComputeHash_2((TextToHash))\r\n        \r\n    If bB64 = True Then\r\n       SHA1 = ConvToBase64String(bytes)\r\n    Else\r\n       SHA1 = ConvToHexString(bytes)\r\n    End If\r\n            \r\n    Set oT = Nothing\r\n    Set oSHA1 = Nothing\r\n    \r\nEnd Function\r\n\r\nPublic Function SHA256(sIn As String, Optional bB64 As Boolean = 0) As String\r\n    'Set a reference to mscorlib 4.0 64-bit\r\n    'Check that Net Framework 3.5 (includes .Net 2 and .Net 3 is installed in windows\r\n    'and not just Net Advanced Services\r\n    \r\n    'Test with empty string input:\r\n    '64 Hex:   e3b0c44298f...etc\r\n    '44 Base-64:   47DEQpj8HBSa+/...etc\r\n    \r\n    Dim oT As Object, oSHA256 As Object\r\n    Dim TextToHash() As Byte, bytes() As Byte\r\n    \r\n    Set oT = CreateObject(\"System.Text.UTF8Encoding\")\r\n    Set oSHA256 = CreateObject(\"System.Security.Cryptography.SHA256Managed\")\r\n    \r\n    TextToHash = oT.Getbytes_4(sIn)\r\n    bytes = oSHA256.ComputeHash_2((TextToHash))\r\n    \r\n    If bB64 = True Then\r\n       SHA256 = ConvToBase64String(bytes)\r\n    Else\r\n       SHA256 = ConvToHexString(bytes)\r\n    End If\r\n    \r\n    Set oT = Nothing\r\n    Set oSHA256 = Nothing\r\n    \r\nEnd Function\r\n\r\nPublic Function SHA384(sIn As String, Optional bB64 As Boolean = 0) As String\r\n    'Set a reference to mscorlib 4.0 64-bit\r\n    'Check that Net Framework 3.5 (includes .Net 2 and .Net 3 is installed in windows\r\n    'and not just Net Advanced Services\r\n    \r\n    'Test with empty string input:\r\n    '96 Hex:   38b060a751ac...etc\r\n    '64 Base-64:   OLBgp1GsljhM2T...etc\r\n    \r\n    Dim oT As Object, oSHA384 As Object\r\n    Dim TextToHash() As Byte, bytes() As Byte\r\n    \r\n    Set oT = CreateObject(\"System.Text.UTF8Encoding\")\r\n    Set oSHA384 = CreateObject(\"System.Security.Cryptography.SHA384Managed\")\r\n    \r\n    TextToHash = oT.Getbytes_4(sIn)\r\n    bytes = oSHA384.ComputeHash_2((TextToHash))\r\n    \r\n    If bB64 = True Then\r\n       SHA384 = ConvToBase64String(bytes)\r\n    Else\r\n       SHA384 = ConvToHexString(bytes)\r\n    End If\r\n    \r\n    Set oT = Nothing\r\n    Set oSHA384 = Nothing\r\n    \r\nEnd Function\r\n\r\nPublic Function SHA512(sIn As String, Optional bB64 As Boolean = 0) As String\r\n    'Set a reference to mscorlib 4.0 64-bit\r\n    'Check that Net Framework 3.5 (includes .Net 2 and .Net 3 is installed in windows\r\n    'and not just Net Advanced Services\r\n    \r\n    'Test with empty string input:\r\n    '128 Hex:   cf83e1357eefb8bd...etc\r\n    '88 Base-64:   z4PhNX7vuL3xVChQ...etc\r\n    \r\n    Dim oT As Object, oSHA512 As Object\r\n    Dim TextToHash() As Byte, bytes() As Byte\r\n    \r\n    Set oT = CreateObject(\"System.Text.UTF8Encoding\")\r\n    Set oSHA512 = CreateObject(\"System.Security.Cryptography.SHA512Managed\")\r\n    \r\n    TextToHash = oT.Getbytes_4(sIn)\r\n    bytes = oSHA512.ComputeHash_2((TextToHash))\r\n    \r\n    If bB64 = True Then\r\n       SHA512 = ConvToBase64String(bytes)\r\n    Else\r\n       SHA512 = ConvToHexString(bytes)\r\n    End If\r\n    \r\n    Set oT = Nothing\r\n    Set oSHA512 = Nothing\r\n    \r\nEnd Function\r\n\r\nFunction StrToSHA512Salt(ByVal sIn As String, ByVal sSecretKey As String, _\r\n                           Optional ByVal b64 As Boolean = False) As String\r\n    'Returns a sha512 STRING HASH in function name, modified by the parameter sSecretKey.\r\n    'This hash differs from that of SHA512 using the SHA512Managed class.\r\n    'HMAC class inputs are hashed twice;first input and key are mixed before hashing,\r\n    'then the key is mixed with the result and hashed again.\r\n    'Check that Net Framework 3.5 (includes .Net 2 and .Net 3 is installed in windows\r\n    'and not just Net Advanced Services\r\n    \r\n    Dim asc As Object, enc As Object\r\n    Dim TextToHash() As Byte\r\n    Dim SecretKey() As Byte\r\n    Dim bytes() As Byte\r\n    \r\n    'Test results with both strings empty:\r\n    '128 Hex:    b936cee86c9f...etc\r\n    '88 Base-64:   uTbO6Gyfh6pd...etc\r\n    \r\n    'create text and crypto objects\r\n    Set asc = CreateObject(\"System.Text.UTF8Encoding\")\r\n    \r\n    'Any of HMACSHAMD5,HMACSHA1,HMACSHA256,HMACSHA384,or HMACSHA512 can be used\r\n    'for corresponding hashes, albeit not matching those of Managed classes.\r\n    Set enc = CreateObject(\"System.Security.Cryptography.HMACSHA512\")\r\n\r\n    'make a byte array of the text to hash\r\n    bytes = asc.Getbytes_4(sIn)\r\n    'make a byte array of the private key\r\n    SecretKey = asc.Getbytes_4(sSecretKey)\r\n    'add the private key property to the encryption object\r\n    enc.Key = SecretKey\r\n\r\n    'make a byte array of the hash\r\n    bytes = enc.ComputeHash_2((bytes))\r\n    \r\n    'convert the byte array to string\r\n    If b64 = True Then\r\n       StrToSHA512Salt = ConvToBase64String(bytes)\r\n    Else\r\n       StrToSHA512Salt = ConvToHexString(bytes)\r\n    End If\r\n    \r\n    'release object variables\r\n    Set asc = Nothing\r\n    Set enc = Nothing\r\n\r\nEnd Function\r\n\r\nPrivate Function ConvToBase64String(vIn As Variant) As Variant\r\n    'Check that Net Framework 3.5 (includes .Net 2 and .Net 3 is installed in windows\r\n    'and not just Net Advanced Services\r\n   \r\n   Dim oD As Object\r\n      \r\n    Set oD = CreateObject(\"MSXML2.DOMDocument\")\r\n      With oD\r\n        .LoadXML \"<root />\"\r\n        .DocumentElement.DataType = \"bin.base64\"\r\n        .DocumentElement.nodeTypedValue = vIn\r\n      End With\r\n    ConvToBase64String = Replace(oD.DocumentElement.Text, vbLf, \"\")\r\n    \r\n    Set oD = Nothing\r\n\r\nEnd Function\r\n\r\nPrivate Function ConvToHexString(vIn As Variant) As Variant\r\n    'Check that Net Framework 3.5 (includes .Net 2 and .Net 3 is installed in windows\r\n    'and not just Net Advanced Services\r\n    \r\n    Dim oD As Object\r\n      \r\n    Set oD = CreateObject(\"MSXML2.DOMDocument\")\r\n      \r\n      With oD\r\n        .LoadXML \"<root />\"\r\n        .DocumentElement.DataType = \"bin.Hex\"\r\n        .DocumentElement.nodeTypedValue = vIn\r\n      End With\r\n    ConvToHexString = Replace(oD.DocumentElement.Text, vbLf, \"\")\r\n    \r\n    Set oD = Nothing\r\n\r\nEnd Function", 
      "DISCRIPTION": "hash функции"
    }, 
    {
      "CODE_GRUP": "Custom", 
      "CODE_SNIPPET": "HaveSheetInFile", 
      "CODE": "Private Function HaveSheetInFile(ByRef wb As Workbook, ByVal SHName As String) As Boolean\r\n    Dim sh          As Worksheet\r\n    On Error Resume Next\r\n    Set sh = wb.Worksheets(SHName)\r\n    HaveSheetInFile = Err.Number = 0\r\n    Err.Clear\r\nEnd Function", 
      "DISCRIPTION": "Проверка существования листа по имени"
    }, 
    {
      "CODE_GRUP": "Custom", 
      "CODE_SNIPPET": "LastCol", 
      "CODE": "    Dim iLastCol    As Integer\r\n    iLastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column\r\n    If iLastCol < 1 Then Exit Sub", 
      "DISCRIPTION": "Последний столбец в строке"
    }, 
    {
      "CODE_GRUP": "Custom", 
      "CODE_SNIPPET": "LastRow", 
      "CODE": "Dim lLastRow    As Long\r\nlLastRow =.Cells(.Rows.Count, 1).End(xlUp).Row\r\nIf lLastRow < 1 Then Exit Sub", 
      "DISCRIPTION": "Последняя строка в столбце"
    }, 
    {
      "CODE_GRUP": "Custom", 
      "CODE_SNIPPET": "Path", 
      "CODE": "Dim errMsg      As String\r\nDim sPathIn     As String\r\n\r\nIf sPathIn = vbNullString Then\r\n    errMsg = errMsg & \"Не выбрана папка куда копировать\" & vbNewLine\r\nElseIf Not FileHave(sPathIn) Then\r\n    errMsg = errMsg & \"Выбрана несуществующая папка куда копировать\" & vbNewLine\r\nEnd If\r\n\r\nIf errMsg <> vbNullString Then\r\n    Call MsgBox(errMsg, vbCritical, \"Ошибка:\")\r\nEnd If", 
      "DISCRIPTION": "Проверка пути к файла"
    }, 
    {
      "CODE_GRUP": "Custom", 
      "CODE_SNIPPET": "replaceSymbols", 
      "CODE": "Private Function replaceSymbols(ByVal txt As String) As String\r\n    Const St        As String = \": ~!@/\\#$%^&*=|`\"\"\"\r\n    Dim i           As Byte\r\n    Dim iCount      As Byte\r\n    iCount = VBA.Len(St$)\r\n    For i = 1 To Len(St$)\r\n        txt = VBA.Replace(txt, VBA.Mid(St, i, 1), \"_\")\r\n    Next\r\n    i = 0\r\n    Do While txt Like \"*__*\"\r\n        txt = VBA.Replace(txt, \"__\", \"_\")\r\n        If i > 100 Then Exit Do\r\n    Loop\r\n    replaceSymbols = txt\r\nEnd Function", 
      "DISCRIPTION": "Замена специальных символов в строке"
    }, 
    {
      "CODE_GRUP": "Custom", 
      "CODE_SNIPPET": "Resize", 
      "CODE": ".Cells(1, 1).Resize(UBound(arr, 1), UBound(arr, 2)).Value2 = arr", 
      "DISCRIPTION": "Выгрузка массива в диапазон"
    }, 
    {
      "CODE_GRUP": "Custom", 
      "CODE_SNIPPET": "ScreenUpdatingCalculation", 
      "CODE": "Public Sub ScreenUpdatingCalculation(ByVal Screen As Boolean, _\r\n                                      ByVal Calculat As Boolean, _\r\n                                      Optional ByVal Alerts As Boolean = True, _\r\n                                      Optional ByVal Events As Boolean = True)\r\n'Screen - тип логический, включение выключение обновления экрана\r\n'Calculat - тип логический, включение выключение пересчета формул\r\n'Alerts - тип логический, включение выключение сообщений, по умолчанию включено\r\n'Events - тип логический, включение выключение обработки событий, по умолчанию включено\r\n\r\n    With Application\r\n        If Calculat Then\r\n            .Calculation = xlCalculationAutomatic\r\n        Else\r\n            .Calculation = xlCalculationManual\r\n        End If\r\n        .ScreenUpdating = Screen\r\n        .DisplayAlerts = Alerts\r\n        .EnableEvents = Events\r\n    End With\r\nEnd Sub", 
      "DISCRIPTION": "Вылючение и выключение обновление экрана и расчета формул"
    }, 
    {
      "CODE_GRUP": "Custom", 
      "CODE_SNIPPET": "SheetCopy", 
      "CODE": "Private Sub CopySheet(ShNameOld As Worksheet, ByVal ShNameNew As String)\r\n    Application.DisplayAlerts = False\r\n    With ShNameOld\r\n        .Select\r\n        .Copy After:=ShNameOld\r\n        ActiveSheet.Name = ShNameNew\r\n    End With\r\n    Application.DisplayAlerts = True\r\nEnd Sub", 
      "DISCRIPTION": "Копировать лист"
    }, 
    {
      "CODE_GRUP": "Custom", 
      "CODE_SNIPPET": "SheetDelete", 
      "CODE": "Private Sub DeleteSheet(ByVal ShName As String)\r\n    On Error Resume Next\r\n    Application.DisplayAlerts = False\r\n    If Not Sheets(ShName) Is Nothing Then\r\n        Sheets(ShName).Delete\r\n    End If\r\n    Application.DisplayAlerts = True\r\nEnd Sub", 
      "DISCRIPTION": "Удалить лист"
    }, 
    {
      "CODE_GRUP": "Custom", 
      "CODE_SNIPPET": "Status", 
      "CODE": "If i Mod 10 = 0 Then Application.StatusBar = \"Выполнено: \" & i & \" из \" & iCount & \" или \" & VBA.Format$(i / iCount, \"Percent\")", 
      "DISCRIPTION": "Вывод сообщения в статус бар"
    }, 
    {
      "CODE_GRUP": "Custom", 
      "CODE_SNIPPET": "StatusBar", 
      "CODE": "* Sub        : StatusBarVBATools\r\n'* Created    : 09-12-2020 20:19\r\n'* Author     : VBATools\r\n'* Contacts   : http://vbatools.ru/ https://vk.com/vbatools\r\n'* Copyright  : VBATools.ru\r\n'* Argument(s):                                     Description\r\n'*\r\n'* ByVal iItem As Long                           : номер элемента\r\n'* ByVal ICOUNT As Long                          : количество элементов\r\n'* Optional iNumberCharacters As Byte = 40       : длина статус бара в символах\r\n'* Optional sChar1 As String = \"|\"               : первый символ который появляется, использовать символы одинаковой ширины. Пример: | . , ! пробел и др.\r\n'* Optional sChar2 As String = \" \"               : второй символ который исчезает, использовать символы одинаковой ширины\r\n'* Optional iDiscrete As Integer = 1             : обновление статус бара, 1-для каждого iTem, 2-только для четных, 100-каждый сотый\r\n'* Optional bReversPct As Boolean = True         : True изменение процентов от 0->100%, False 100->0%\r\n'* Optional sStringTemp As String = vbNullString : Произвольный текст в конце\r\n\r\nPrivate Sub StatusBarVBATools(ByVal iItem As Long, ByVal ICOUNT As Long, Optional iNumberCharacters As Byte = 40, _\r\n        Optional sChar1 As String = \"|\", Optional sChar2 As String = \" \", _\r\n        Optional iDiscrete As Integer = 1, Optional bReversPct As Boolean = True, Optional sStringTemp As String = vbNullString)\r\n\r\n    Dim CurrentStatus As Integer\r\n    Dim pctDone     As Integer\r\n\r\n    If iItem > ICOUNT Then\r\n        Application.StatusBar = False\r\n        Exit Sub\r\n    End If\r\n\r\n    If iItem Mod iDiscrete = 0 Then\r\n        If iNumberCharacters > 230 Then iNumberCharacters = 230\r\n        CurrentStatus = Int((iItem / ICOUNT) * iNumberCharacters)\r\n        If bReversPct Then\r\n            pctDone = CurrentStatus / iNumberCharacters * 100\r\n        Else\r\n            pctDone = (1 - CurrentStatus / iNumberCharacters) * 100\r\n        End If\r\n        Application.StatusBar = \"[\" & VBA.String$(CurrentStatus, sChar1) & VBA.String$(iNumberCharacters - CurrentStatus, sChar2) & \"]\" & \" \" & pctDone & \"%\" & sStringTemp\r\n        DoEvents\r\n    End If\r\n    If iItem = ICOUNT Then Application.StatusBar = False\r\nEnd Sub", 
      "DISCRIPTION": "Вывод статус бара"
    }, 
    {
      "CODE_GRUP": "Custom", 
      "CODE_SNIPPET": "wbIsOpen", 
      "CODE": "Private Function wbIsOpen(ByVal sNameWb As String) As Boolean\r\n    On Error Resume Next\r\n    Dim wb          As Workbook\r\n    Set wb = Workbooks(sNameWb)\r\n    wbIsOpen = Err.Number = 0\r\n    Err.Clear\r\nEnd Function", 
      "DISCRIPTION": "Проверка открыта ли книга"
    }, 
    {
      "CODE_GRUP": "Custom", 
      "CODE_SNIPPET": "WriterLogSub", 
      "CODE": "Public Enum LOG_LEVEL\r\n    eINFO = 0\r\n    eWARNING = 1\r\n    eERROR = 2\r\nEnd Enum\r\n\r\nPublic Sub WriterLog(ByVal sNameFunc As String, ByVal logLevel As LOG_LEVEL, Optional sMsg As String = vbNullString)\r\n    Dim bDebug      As Boolean\r\n    bDebug = True\r\n\r\n    Const MESSAGE As String = \"Message     : \"\r\n    Const NEW_LINE_TAB As String = vbCrLf & vbTab\r\n\r\n    Select Case logLevel\r\n            Case eINFO\r\n            If sMsg <> vbNullString And bDebug Then Debug.Print \">> [INFO] \" & sNameFunc & NEW_LINE_TAB & MESSAGE & sMsg\r\n        Case eWARNING\r\n            If sMsg <> vbNullString And bDebug Then Debug.Print \">> [WARNING] \" & sNameFunc & NEW_LINE_TAB & MESSAGE & sMsg\r\n        Case eERROR\r\n            If Err.Number <> 0 Then\r\n                Dim errMsg As String\r\n                errMsg = \">> [ERROR] \" & sNameFunc\r\n                If sMsg <> vbNullString Then errMsg = errMsg & NEW_LINE_TAB & MESSAGE & sMsg\r\n                errMsg = errMsg & NEW_LINE_TAB & \"Error Number: \" & Err.Number & NEW_LINE_TAB & \"Description : \" & Err.DESCRIPTION\r\n                If Erl > 0 Then errMsg = errMsg & NEW_LINE_TAB & \"At line     : \" & Erl\r\n                Debug.Print errMsg\r\n            End If\r\n    End Select\r\nEnd Sub", 
      "DISCRIPTION": "Логер"
    }, 
    {
      "CODE_GRUP": "DoLoop", 
      "CODE_SNIPPET": "DoLoUn", 
      "CODE": "Do\r\n    \r\nLoop Until ", 
      "DISCRIPTION": "Цикл  Do Loop Until"
    }, 
    {
      "CODE_GRUP": "DoLoop", 
      "CODE_SNIPPET": "DoLoWh", 
      "CODE": "Do\r\n    \r\nLoop While ", 
      "DISCRIPTION": "Цикл  Do Loop While "
    }, 
    {
      "CODE_GRUP": "DoLoop", 
      "CODE_SNIPPET": "DoUnLo", 
      "CODE": "Do Until\r\n    \r\nLoop\r\n", 
      "DISCRIPTION": "Цикл  Do Until Loop"
    }, 
    {
      "CODE_GRUP": "DoLoop", 
      "CODE_SNIPPET": "DoWhLo", 
      "CODE": "Do While\r\r\n    \r\r\nLoop", 
      "DISCRIPTION": "Цикл  Do While Loop"
    }, 
    {
      "CODE_GRUP": "DoLoop", 
      "CODE_SNIPPET": "ForEa", 
      "CODE": "For Each  In\r\n    \r\nNext", 
      "DISCRIPTION": "Цикл For Each .. In"
    }, 
    {
      "CODE_GRUP": "DoLoop", 
      "CODE_SNIPPET": "ForEaW", 
      "CODE": "For Each ws In Worksheets\r\n     \r\nNext", 
      "DISCRIPTION": "Цикл перебора листов книги"
    }, 
    {
      "CODE_GRUP": "DoLoop", 
      "CODE_SNIPPET": "ForI", 
      "CODE": "For i=1 to 10\r\n\r\nNext i", 
      "DISCRIPTION": "Цикл For I to 10"
    }, 
    {
      "CODE_GRUP": "DoLoop", 
      "CODE_SNIPPET": "ForIS", 
      "CODE": "For i=1 to 10 step 1\r\n\r\nNext i", 
      "DISCRIPTION": "Цикл For i=1 to 10 step 1 с шагом"
    }, 
    {
      "CODE_GRUP": "Forms", 
      "CODE_SNIPPET": "clsAnchors", 
      "clsAnchors.cls": "\n'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\n'*  Class: clsAnchors\n'*  Author: VBATools\n'*  Version: 1.1.0\n'*  Creation Date: 03.05.2019 09:31\n'*  Last Update Date: 12.11.2025 23:57\n'*  License: Apache License\n'*  Description: Provides anchor-based resizing for MSForms UserForm controls\n'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\n\n'==========================================================================================\n' ENUMERATIONS\n'==========================================================================================\n\nPublic Enum AnchorEdge\n    anchorNone = 0\n    anchorTop = 1\n    anchorBottom = 2\n    anchorLeft = 4\n    anchorRight = 8\nEnd Enum\n\nPrivate Enum ControlParamIndex\n    idxAnchorStyle = 1\n    idxMinimumWidth\n    idxMinimumHeight\n    idxMinimumTop\n    idxMinimumLeft\n    idxOriginalLeft\n    idxOriginalTop\n    idxOriginalWidth\n    idxOriginalHeight\n    idxControlName\n    [_First] = idxAnchorStyle\n    [_Last] = idxControlName\nEnd Enum\n\n'==========================================================================================\n' CONSTANTS\n'==========================================================================================\n\nPrivate Const CLASS_NAME As String = \"clsAnchors\"\nPrivate Const CLASS_VERSION As String = \"1.1.0\"\n\nPrivate Const RESIZE_HANDLE_SUFFIX As String = \"ResizeGrabHandle\"\nPrivate Const HANDLE_SUFFIX_BOTTOM As String = \"_BOTTOM\"\nPrivate Const HANDLE_SUFFIX_RIGHT As String = \"_RIGHT\"\n\nPrivate Const MOUSE_BUTTON_LEFT As Integer = 1\n\nPrivate Const DEFAULT_HANDLE_SIZE As Single = 2\nPrivate Const DEFAULT_HANDLE_FONT_SIZE As Single = 14\nPrivate Const HANDLE_COLOR As Long = &HC0C0C0\n\n'==========================================================================================\n' MODULE-LEVEL VARIABLES\n'==========================================================================================\n\n' Parent form reference\nPrivate mParent As Object\n\n' Collection of control parameters\nPrivate mItems As Collection\n\n' Resize handles\nPrivate WithEvents mResizeHandle As MSForms.Label\nPrivate WithEvents mResizeHandleBottom As MSForms.Label\nPrivate WithEvents mResizeHandleRight As MSForms.Label\n\n' State flags\nPrivate mIsResizing As Boolean\nPrivate mUpdateWhileDragging As Boolean\nPrivate mIsInitialized As Boolean\n\n' Resize tracking\nPrivate mResizeStartX As Single\nPrivate mResizeStartY As Single\n\n' Form dimension constraints\nPrivate mMinWidth As Single\nPrivate mMinHeight As Single\nPrivate mMaxHeight As Single\nPrivate mMaxWidth As Single\n\n' Original form dimensions\nPrivate mOriginalInsideWidth As Single\nPrivate mOriginalInsideHeight As Single\n\n' Control count at initialization\nPrivate mControlCount As Integer\n\n' Handle base name\nPrivate mHandleBaseName As String\n\n'==========================================================================================\n' PUBLIC PROPERTIES\n'==========================================================================================\n\nPublic Property Get Version() As String\n    Version = \"Class: \" & CLASS_NAME & vbNewLine & _\n              \"Author: VBATools\" & vbNewLine & _\n              \"Version: \" & CLASS_VERSION & vbNewLine & _\n              \"Creation Date: 03.05.2019 09:31\" & vbNewLine & _\n              \"Last Update: 12.11.2025 23:57\" & vbNewLine & _\n              \"License: Apache License\" & vbNewLine & _\n              \"Description: Anchor-based control resizing for UserForms\"\nEnd Property\n\nPublic Property Get CountAnchors() As Byte\n    If Not mItems Is Nothing Then\n        CountAnchors = mItems.Count\n    End If\nEnd Property\n\n'==========================================================================================\n' PUBLIC METHODS\n'==========================================================================================\n\nPublic Sub Initialize(ByVal objParent As Object, _\n                       Optional ByVal MaximumHeight As Single, _\n                       Optional ByVal MaximumWidth As Single)\n    \n    If mIsInitialized Then\n        Err.Raise vbObjectError + 1, CLASS_NAME, \"The class has already been initialized\"\n        Exit Sub\n    End If\n    \n    If objParent Is Nothing Then\n        Err.Raise vbObjectError + 3, CLASS_NAME, \"Parent object cannot be Nothing\"\n        Exit Sub\n    End If\n    \n    Call CreateResizeHandles(objParent, MaximumHeight, MaximumWidth)\n    Call InitializeControlCollection\n    Call SetDefaultHandleAnchors\n    \n    mIsInitialized = True\n    \nEnd Sub\n\nPublic Sub SetAnchorStyleByName(ByVal ControlName As String, _\n                                 ByVal anchorStyle As AnchorEdge)\n    \n    If mItems Is Nothing Then\n        Err.Raise vbObjectError + 2, CLASS_NAME, \"Item collection not initialized\"\n        Exit Sub\n    End If\n    \n    Dim controlParams As Variant\n    Dim i As Integer\n    \n    On Error Resume Next\n    controlParams = mItems(ControlName)\n    \n    If Err.Number <> 0 Then\n        Err.Clear\n        Err.Raise vbObjectError + 4, CLASS_NAME, \"Control '\" & ControlName & \"' not found\"\n        Exit Sub\n    End If\n    On Error GoTo 0\n    \n    controlParams(ControlParamIndex.idxAnchorStyle) = anchorStyle\n    \n    mItems.Remove ControlName\n    mItems.Add controlParams, ControlName\n    \nEnd Sub\n\n'==========================================================================================\n' PRIVATE METHODS - INITIALIZATION\n'==========================================================================================\n\nPrivate Sub CreateResizeHandles(ByVal objParent As Object, _\n                                 ByVal MaximumHeight As Single, _\n                                 ByVal MaximumWidth As Single)\n    \n    mHandleBaseName = objParent.Name & RESIZE_HANDLE_SUFFIX\n    \n    ' Create corner handle (diagonal resize)\n    Call CreateCornerHandle(objParent)\n    \n    ' Create bottom edge handle (vertical resize)\n    Call CreateBottomHandle(objParent)\n    \n    ' Create right edge handle (horizontal resize)\n    Call CreateRightHandle(objParent)\n    \n    ' Store parent reference and initialize dimensions\n    Set mParent = objParent\n    \n    With objParent\n        mMinWidth = .Width\n        mMinHeight = .Height\n        mOriginalInsideWidth = .InsideWidth\n        mOriginalInsideHeight = .InsideHeight\n    End With\n    \n    ' Set maximum dimensions (default to minimum if not specified)\n    mMaxHeight = IIf(MaximumHeight > 0, MaximumHeight, mMinHeight)\n    mMaxWidth = IIf(MaximumWidth > 0, MaximumWidth, mMinWidth)\n    \n    mControlCount = mParent.Controls.Count\n    Set mItems = New Collection\n    mUpdateWhileDragging = True\n    \nEnd Sub\n\nPrivate Sub CreateCornerHandle(ByVal objParent As Object)\n    \n    Set mResizeHandle = objParent.Controls.Add(\"Forms.Label.1\", mHandleBaseName, True)\n    \n    With mResizeHandle\n        With .Font\n            .Name = \"Marlett\"\n            .Charset = 2\n            .Size = DEFAULT_HANDLE_FONT_SIZE\n            .Bold = True\n        End With\n        \n        .BackStyle = fmBackStyleTransparent\n        .AutoSize = True\n        .BorderStyle = fmBorderStyleNone\n        .Caption = \"o\"\n        .MousePointer = fmMousePointerSizeNWSE\n        .ForeColor = HANDLE_COLOR\n        .ZOrder\n        .Top = objParent.InsideHeight - .Height\n        .Left = objParent.InsideWidth - .Width\n    End With\n    \nEnd Sub\n\nPrivate Sub CreateBottomHandle(ByVal objParent As Object)\n    \n    Set mResizeHandleBottom = objParent.Controls.Add( _\n        \"Forms.Label.1\", _\n        mHandleBaseName & HANDLE_SUFFIX_BOTTOM, _\n        True)\n    \n    With mResizeHandleBottom\n        .MousePointer = fmMousePointerSizeNS\n        .ZOrder\n        .Left = 0\n        .Height = DEFAULT_HANDLE_SIZE\n        .Top = objParent.InsideHeight - .Height\n        .Width = objParent.InsideWidth\n    End With\n    \nEnd Sub\n\nPrivate Sub CreateRightHandle(ByVal objParent As Object)\n    \n    Set mResizeHandleRight = objParent.Controls.Add( _\n        \"Forms.Label.1\", _\n        mHandleBaseName & HANDLE_SUFFIX_RIGHT, _\n        True)\n    \n    With mResizeHandleRight\n        .MousePointer = fmMousePointerSizeWE\n        .ZOrder\n        .Width = DEFAULT_HANDLE_SIZE\n        .Left = objParent.InsideWidth - .Width\n        .Height = objParent.InsideHeight\n        .Top = 0\n    End With\n    \nEnd Sub\n\nPrivate Sub InitializeControlCollection()\n    \n    Dim controlParams() As Variant\n    ReDim controlParams(ControlParamIndex.[_First] To ControlParamIndex.[_Last]) As Variant\n    \n    Dim i As Integer\n    \n    For i = 0 To mControlCount - 1\n        With mParent.Controls(i)\n            controlParams(ControlParamIndex.idxAnchorStyle) = anchorLeft Or anchorTop\n            controlParams(ControlParamIndex.idxMinimumWidth) = .Width\n            controlParams(ControlParamIndex.idxMinimumHeight) = .Height\n            controlParams(ControlParamIndex.idxMinimumTop) = .Top\n            controlParams(ControlParamIndex.idxMinimumLeft) = .Left\n            controlParams(ControlParamIndex.idxOriginalLeft) = .Left\n            controlParams(ControlParamIndex.idxOriginalTop) = .Top\n            controlParams(ControlParamIndex.idxOriginalWidth) = .Width\n            controlParams(ControlParamIndex.idxOriginalHeight) = .Height\n            controlParams(ControlParamIndex.idxControlName) = .Name\n            \n            mItems.Add controlParams, .Name\n        End With\n    Next i\n    \nEnd Sub\n\nPrivate Sub SetDefaultHandleAnchors()\n    \n    Call SetAnchorStyleByName( _\n        mHandleBaseName & HANDLE_SUFFIX_BOTTOM, _\n        anchorBottom Or anchorRight Or anchorLeft)\n    \n    Call SetAnchorStyleByName( _\n        mHandleBaseName & HANDLE_SUFFIX_RIGHT, _\n        anchorBottom Or anchorRight Or anchorTop)\n    \nEnd Sub\n\n'==========================================================================================\n' PRIVATE METHODS - MOUSE EVENT HANDLERS\n'==========================================================================================\n\n' --- MouseDown Events ---\n\nPrivate Sub mResizeHandle_MouseDown(ByVal Button As Integer, _\n                                     ByVal Shift As Integer, _\n                                     ByVal X As Single, _\n                                     ByVal Y As Single)\n    Call HandleMouseDown(Button, X, Y)\nEnd Sub\n\nPrivate Sub mResizeHandleBottom_MouseDown(ByVal Button As Integer, _\n                                           ByVal Shift As Integer, _\n                                           ByVal X As Single, _\n                                           ByVal Y As Single)\n    Call HandleMouseDown(Button, X, Y)\nEnd Sub\n\nPrivate Sub mResizeHandleRight_MouseDown(ByVal Button As Integer, _\n                                          ByVal Shift As Integer, _\n                                          ByVal X As Single, _\n                                          ByVal Y As Single)\n    Call HandleMouseDown(Button, X, Y)\nEnd Sub\n\n' --- MouseUp Events ---\n\nPrivate Sub mResizeHandle_MouseUp(ByVal Button As Integer, _\n                                   ByVal Shift As Integer, _\n                                   ByVal X As Single, _\n                                   ByVal Y As Single)\n    Call HandleMouseUp(Button)\nEnd Sub\n\nPrivate Sub mResizeHandleBottom_MouseUp(ByVal Button As Integer, _\n                                         ByVal Shift As Integer, _\n                                         ByVal X As Single, _\n                                         ByVal Y As Single)\n    Call HandleMouseUp(Button)\nEnd Sub\n\nPrivate Sub mResizeHandleRight_MouseUp(ByVal Button As Integer, _\n                                        ByVal Shift As Integer, _\n                                        ByVal X As Single, _\n                                        ByVal Y As Single)\n    Call HandleMouseUp(Button)\nEnd Sub\n\n' --- MouseMove Events ---\n\nPrivate Sub mResizeHandle_MouseMove(ByVal Button As Integer, _\n                                     ByVal Shift As Integer, _\n                                     ByVal X As Single, _\n                                     ByVal Y As Single)\n    \n    If Button <> MOUSE_BUTTON_LEFT Or Not mIsResizing Then Exit Sub\n    \n    Dim newWidth As Single\n    Dim newHeight As Single\n    \n    newWidth = CalculateNewDimension(mParent.Width, X - mResizeStartX, mMinWidth, mMaxWidth)\n    newHeight = CalculateNewDimension(mParent.Height, Y - mResizeStartY, mMinHeight, mMaxHeight)\n    \n    mParent.Width = newWidth\n    mParent.Height = newHeight\n    \n    Call UpdateHandlePositions\n    Call UpdateControlsIfNeeded\n    \nEnd Sub\n\nPrivate Sub mResizeHandleBottom_MouseMove(ByVal Button As Integer, _\n                                           ByVal Shift As Integer, _\n                                           ByVal X As Single, _\n                                           ByVal Y As Single)\n    \n    If Button <> MOUSE_BUTTON_LEFT Or Not mIsResizing Then Exit Sub\n    \n    Dim newHeight As Single\n    \n    newHeight = CalculateNewDimension(mParent.Height, Y - mResizeStartY, mMinHeight, mMaxHeight)\n    mParent.Height = newHeight\n    \n    Call UpdateHandlePositions\n    Call UpdateControlsIfNeeded\n    \nEnd Sub\n\nPrivate Sub mResizeHandleRight_MouseMove(ByVal Button As Integer, _\n                                          ByVal Shift As Integer, _\n                                          ByVal X As Single, _\n                                          ByVal Y As Single)\n    \n    If Button <> MOUSE_BUTTON_LEFT Or Not mIsResizing Then Exit Sub\n    \n    Dim newWidth As Single\n    \n    newWidth = CalculateNewDimension(mParent.Width, X - mResizeStartX, mMinWidth, mMaxWidth)\n    mParent.Width = newWidth\n    \n    Call UpdateHandlePositions\n    Call UpdateControlsIfNeeded\n    \nEnd Sub\n\n'==========================================================================================\n' PRIVATE METHODS - MOUSE HANDLER HELPERS\n'==========================================================================================\n\nPrivate Sub HandleMouseDown(ByVal Button As Integer, _\n                             ByVal X As Single, _\n                             ByVal Y As Single)\n    \n    If Button = MOUSE_BUTTON_LEFT Then\n        mResizeStartX = X\n        mResizeStartY = Y\n        mIsResizing = True\n    End If\n    \nEnd Sub\n\nPrivate Sub HandleMouseUp(ByVal Button As Integer)\n    \n    If Button = MOUSE_BUTTON_LEFT Then\n        If Not mUpdateWhileDragging Then\n            Call UpdateControlPositions\n        End If\n        mIsResizing = False\n    End If\n    \nEnd Sub\n\nPrivate Function CalculateNewDimension(ByVal currentValue As Single, _\n                                         ByVal delta As Single, _\n                                         ByVal minValue As Single, _\n                                         ByVal maxValue As Single) As Single\n    \n    Dim result As Single\n    result = currentValue + delta\n    \n    ' Clamp to min/max bounds\n    If result < minValue Then\n        result = minValue\n    ElseIf result > maxValue Then\n        result = maxValue\n    End If\n    \n    CalculateNewDimension = result\n    \nEnd Function\n\nPrivate Sub UpdateHandlePositions()\n    \n    With mResizeHandle\n        .Left = mParent.InsideWidth - .Width\n        .Top = mParent.InsideHeight - .Height\n    End With\n    \n    With mResizeHandleBottom\n        .Top = mParent.InsideHeight - .Height\n        .Width = mParent.InsideWidth\n    End With\n    \n    With mResizeHandleRight\n        .Left = mParent.InsideWidth - .Width\n        .Height = mParent.InsideHeight\n    End With\n    \nEnd Sub\n\nPrivate Sub UpdateControlsIfNeeded()\n    If mUpdateWhileDragging Then Call UpdateControlPositions\nEnd Sub\n\n'==========================================================================================\n' PRIVATE METHODS - CONTROL POSITIONING\n'==========================================================================================\n\nPrivate Sub UpdateControlPositions()\n    \n    Dim i As Integer\n    Dim controlParams As Variant\n    Dim anchorStyle As AnchorEdge\n    \n    For i = 0 To mControlCount - 1\n        controlParams = mItems(mParent.Controls(i).Name)\n        anchorStyle = controlParams(ControlParamIndex.idxAnchorStyle)\n        \n        If anchorStyle <> anchorNone Then\n            Call ApplyAnchorStyle(i, controlParams, anchorStyle)\n        End If\n    Next i\n    \n    DoEvents\n    \nEnd Sub\n\nPrivate Sub ApplyAnchorStyle(ByVal controlIndex As Integer, _\n                              ByVal params As Variant, _\n                              ByVal anchorStyle As AnchorEdge)\n    \n    Dim hasTop As Boolean\n    Dim hasBottom As Boolean\n    Dim hasLeft As Boolean\n    Dim hasRight As Boolean\n    \n    hasTop = (anchorStyle And anchorTop) = anchorTop\n    hasBottom = (anchorStyle And anchorBottom) = anchorBottom\n    hasLeft = (anchorStyle And anchorLeft) = anchorLeft\n    hasRight = (anchorStyle And anchorRight) = anchorRight\n    \n    ' Apply vertical anchoring\n    Call ApplyVerticalAnchor(controlIndex, params, hasTop, hasBottom)\n    \n    ' Apply horizontal anchoring\n    Call ApplyHorizontalAnchor(controlIndex, params, hasLeft, hasRight)\n    \nEnd Sub\n\nPrivate Sub ApplyVerticalAnchor(ByVal controlIndex As Integer, _\n                                 ByVal params As Variant, _\n                                 ByVal hasTop As Boolean, _\n                                 ByVal hasBottom As Boolean)\n    \n    Dim newHeight As Single\n    Dim newTop As Single\n    \n    With mParent\n        If hasTop And hasBottom Then\n            ' Stretch vertically - adjust height\n            newHeight = .InsideHeight - (mOriginalInsideHeight - params(ControlParamIndex.idxOriginalTop) - params(ControlParamIndex.idxOriginalHeight)) - params(ControlParamIndex.idxOriginalTop)\n            newHeight = ClampValue(newHeight, params(ControlParamIndex.idxMinimumHeight))\n            .Controls(controlIndex).Height = newHeight\n            \n        ElseIf hasBottom Then\n            ' Anchor to bottom - adjust top position\n            newTop = .InsideHeight - (mOriginalInsideHeight - params(ControlParamIndex.idxOriginalTop) - params(ControlParamIndex.idxOriginalHeight)) - params(ControlParamIndex.idxOriginalHeight)\n            newTop = ClampValue(newTop, params(ControlParamIndex.idxMinimumTop))\n            .Controls(controlIndex).Top = newTop\n            \n        ' ElseIf hasTop Only - no change needed\n        End If\n    End With\n    \nEnd Sub\n\nPrivate Sub ApplyHorizontalAnchor(ByVal controlIndex As Integer, _\n                                   ByVal params As Variant, _\n                                   ByVal hasLeft As Boolean, _\n                                   ByVal hasRight As Boolean)\n    \n    Dim newWidth As Single\n    Dim newLeft As Single\n    \n    With mParent\n        If hasLeft And hasRight Then\n            ' Stretch horizontally - adjust width\n            newWidth = .InsideWidth - (mOriginalInsideWidth - params(ControlParamIndex.idxOriginalLeft) - params(ControlParamIndex.idxOriginalWidth)) - params(ControlParamIndex.idxOriginalLeft)\n            newWidth = ClampValue(newWidth, params(ControlParamIndex.idxMinimumWidth))\n            .Controls(controlIndex).Width = newWidth\n            \n        ElseIf hasRight Then\n            ' Anchor to right - adjust left position\n            newLeft = .InsideWidth - (mOriginalInsideWidth - params(ControlParamIndex.idxOriginalLeft) - params(ControlParamIndex.idxOriginalWidth)) - params(ControlParamIndex.idxOriginalWidth)\n            newLeft = ClampValue(newLeft, params(ControlParamIndex.idxMinimumLeft))\n            .Controls(controlIndex).Left = newLeft\n            \n        ' ElseIf hasLeft Only - no change needed\n        End If\n    End With\n    \nEnd Sub\n\nPrivate Function ClampValue(ByVal value As Single, ByVal minValue As Single) As Single\n    \n    If value < minValue Then\n        value = minValue\n    End If\n    \n    If value < 0 Then\n        value = 0\n    End If\n    \n    ClampValue = value\n    \nEnd Function", 
      "CODE": "Dim clsAnc As clsAnchors\r\n\r\nPrivate Sub UserForm_Initialize()\r\n    With Me\r\n        .StartUpPosition = 0\r\n        .Left = Application.Left + 0.5 * (Application.Width - .Width)\r\n        .Top = Application.Top + 0.5 * (Application.Height - .Height)\r\n    End With\r\n    \r\n    Set clsAnc = New clsAnchors\r\n    With clsAnc\r\n        Call .Initialize(Me, 600, 1000)\r\n        Call .setAnchorStyleByName(TextBox1.Name, enumAnchorStyleLeft Or enumAnchorStyleRight)\r\n        Call .setAnchorStyleByName(TextBox2.Name, enumAnchorStyleLeft Or enumAnchorStyleRight Or enumAnchorStyleTop Or enumAnchorStyleBottom)\r\n        Call .setAnchorStyleByName(TextBox3.Name, enumAnchorStyleLeft Or enumAnchorStyleRight Or enumAnchorStyleBottom)\r\n        Call .setAnchorStyleByName(lbVersion.Name, enumAnchorStyleLeft Or enumAnchorStyleRight Or enumAnchorStyleBottom)\r\n        lbVersion.Caption = .Version\r\n    End With\r\nEnd Sub", 
      "DISCRIPTION": "Создание резиновой формы"
    }, 
    {
      "CODE_GRUP": "Forms", 
      "CODE_SNIPPET": "clsButtonIcon", 
      "clsButtonIcon.cls": "Private Const FONT_NAME_ICON As String = \"Segoe MDL2 Assets\"\n\nPrivate WithEvents mLabelMain As MSForms.label\nPrivate mLabelOut   As MSForms.label\nPrivate mLabelIn    As MSForms.label\n\nPrivate mItems      As Collection\n\nPrivate mName       As String\n\nPrivate mIconCodeOutOn As String\nPrivate mIconCodeOutOff As String\nPrivate mIconCodeInOn As String\nPrivate mIconCodeInOff As String\n\nPrivate msnSizeOut  As Single\nPrivate msnSizeIn   As Single\n\nPrivate mColorInOff As XlRgbColor\nPrivate mColorInOn  As XlRgbColor\nPrivate mColorOutOff As XlRgbColor\nPrivate mColorOutOn As XlRgbColor\n\nPrivate mVisible    As Boolean\nPrivate mEnabled    As Boolean\n\nPublic Property Get Name() As String\n    Call errRaise\n    Name = mName\nEnd Property\n\nPublic Property Let Name(ByVal Name As String)\n    Call errRaise\n    mName = Name\nEnd Property\n\nPublic Property Get IconCodeOutOn() As String\n    Call errRaise\n    IconCodeOutOn = mIconCodeOutOn\nEnd Property\n\nPublic Property Let IconCodeOutOn(ByVal Code As String)\n    Call errRaise\n    mIconCodeOutOn = Code\nEnd Property\n\nPublic Property Get IconCodeOutOff() As String\n    Call errRaise\n    IconCodeOutOff = mIconCodeOutOff\nEnd Property\n\nPublic Property Let IconCodeOutOff(ByVal Code As String)\n    Call errRaise\n    mIconCodeOutOff = Code\nEnd Property\n\nPublic Property Get IconCodeInOn() As String\n    Call errRaise\n    IconCodeInOn = mIconCodeInOn\nEnd Property\n\nPublic Property Let IconCodeInOn(ByVal Code As String)\n    Call errRaise\n    mIconCodeInOn = Code\nEnd Property\n\nPublic Property Get IconCodeInOff() As String\n    Call errRaise\n    IconCodeInOff = mIconCodeInOff\nEnd Property\n\nPublic Property Let IconCodeInOff(ByVal Code As String)\n    Call errRaise\n    mIconCodeInOff = Code\nEnd Property\n\nPublic Property Get SizeOut() As Single\n    Call errRaise\n    SizeOut = msnSizeOut\nEnd Property\n\nPublic Property Let SizeOut(ByVal Size As Single)\n    Call errRaise\n    msnSizeOut = Size\nEnd Property\n\nPublic Property Get SizeIn() As Single\n    Call errRaise\n    SizeIn = msnSizeIn\nEnd Property\n\nPublic Property Let SizeIn(ByVal Size As Single)\n    Call errRaise\n    msnSizeIn = Size\nEnd Property\n\nPublic Property Get LabelMain() As MSForms.label\n    Call errRaise\n    Set LabelMain = mLabelMain\nEnd Property\n\nPublic Property Set LabelMain(ByRef label As MSForms.label)\n    Set mLabelMain = label\nEnd Property\n\nPublic Property Get LabelOut() As MSForms.label\n    Call errRaise\n    Set LabelOut = mLabelOut\nEnd Property\n\nPublic Property Set LabelOut(ByRef label As MSForms.label)\n    Call errRaise\n    Set mLabelOut = label\nEnd Property\n\nPublic Property Get LabelIn() As MSForms.label\n    Call errRaise\n    Set LabelIn = mLabelIn\nEnd Property\n\nPublic Property Set LabelIn(ByRef label As MSForms.label)\n    Call errRaise\n    Set mLabelIn = label\nEnd Property\n\nPublic Property Get Items() As Collection\n    Set Items = mItems\nEnd Property\n\nPublic Property Set Items(ByRef item As Collection)\n    Set mItems = item\nEnd Property\n\nPublic Property Get ColorOutOn() As XlRgbColor\n    Call errRaise\n    ColorOutOn = mColorOutOn\nEnd Property\n\nPublic Property Let ColorOutOn(ByVal Color As XlRgbColor)\n    Call errRaise\n    mColorOutOn = Color\nEnd Property\n\nPublic Property Get ColorOutOff() As XlRgbColor\n    Call errRaise\n    ColorOutOff = mColorOutOff\nEnd Property\n\nPublic Property Let ColorOutOff(ByVal Color As XlRgbColor)\n    Call errRaise\n    mColorOutOff = Color\nEnd Property\n\nPublic Property Get ColorInOn() As XlRgbColor\n    Call errRaise\n    ColorInOn = mColorInOn\nEnd Property\n\nPublic Property Let ColorInOn(ByVal Color As XlRgbColor)\n    Call errRaise\n    mColorInOn = Color\nEnd Property\n\nPublic Property Get ColorInOff() As XlRgbColor\n    Call errRaise\n    ColorInOff = mColorInOff\nEnd Property\n\nPublic Property Let ColorInOff(ByVal Color As XlRgbColor)\n    Call errRaise\n    mColorInOff = Color\nEnd Property\n\nPublic Property Get Visible() As Boolean\n    Call errRaise\n    Visible = mVisible\nEnd Property\n\nPublic Property Let Visible(ByVal Visible As Boolean)\n    Call errRaise\n    mVisible = Visible\n    mLabelMain.Visible = Visible\n    mLabelOut.Visible = Visible\n    mLabelIn.Visible = Visible\nEnd Property\n\nPublic Property Get Enabled() As Boolean\n    Call errRaise\n    Enabled = mEnabled\nEnd Property\n\nPublic Property Let Enabled(ByVal Enabled As Boolean)\n    Call errRaise\n    mEnabled = Enabled\n    mLabelMain.Enabled = Enabled\n    mLabelOut.Enabled = Enabled\n    mLabelIn.Enabled = Enabled\nEnd Property\n\nPublic Property Get Count() As Byte\n    Count = mItems.Count\nEnd Property\n\nPublic Property Get getItemByIndex(ByVal index As Integer) As clsButtonIcon\n    On Error GoTo endGetItem\n    Set getItemByIndex = mItems(index)\n    Exit Property\nendGetItem:\n    Err.Clear\nEnd Property\n\nPublic Property Get getItemByName(ByVal Name As String) As clsButtonIcon\n    On Error GoTo endGetItem\n    Set getItemByName = mItems(Name)\n    Exit Property\nendGetItem:\n    Err.Clear\nEnd Property\n\nPrivate Sub errRaise()\n    If mLabelMain Is Nothing Then Call Err.Raise(Number:=vbObjectError + 100, Description:=\"Item button is not set\")\nEnd Sub\n\nPublic Sub addItem(ByRef label As MSForms.label, _\n        ByVal OutIconCodeOn As String, _\n        ByVal OutIconCodeOff As String, _\n        ByVal OutColorOff As XlRgbColor, _\n        ByVal OutColorOn As XlRgbColor, _\n        ByVal InIconCodeOn As String, _\n        ByVal InIconCodeOff As String, _\n        ByVal InColorOff As XlRgbColor, _\n        ByVal InColorOn As XlRgbColor)\n\n    Dim itemCls     As clsButtonIcon\n    Set itemCls = New clsButtonIcon\n\n    With itemCls\n        Set .LabelMain = label\n        .Name = .LabelMain.Name\n        .SizeOut = label.height\n        .SizeIn = .SizeOut * 0.75\n        .IconCodeOutOn = OutIconCodeOn\n        .IconCodeOutOff = OutIconCodeOff\n        .ColorOutOn = OutColorOn\n        .ColorOutOff = OutColorOff\n        .IconCodeInOn = InIconCodeOn\n        .IconCodeInOff = InIconCodeOff\n        .ColorInOn = InColorOn\n        .ColorInOff = InColorOff\n\n        With .LabelMain\n            Set itemCls.LabelOut = .Parent.Controls.Add(\"Forms.Label.1\", .Name & \"_OUT\")\n            Set itemCls.LabelIn = .Parent.Controls.Add(\"Forms.Label.1\", .Name & \"_IN\")\n            .width = itemCls.SizeOut\n            .BorderStyle = fmBorderStyleNone\n            .BackStyle = fmBackStyleTransparent\n            .Caption = vbNullString\n        End With\n        With .LabelOut\n            .top = itemCls.LabelMain.top\n            .left = itemCls.LabelMain.left\n            .width = itemCls.SizeOut\n            .height = itemCls.SizeOut\n            .Font.Size = itemCls.SizeOut * 0.9\n            .Font.Name = FONT_NAME_ICON\n            .Caption = itemCls.IconCodeOutOn\n            .TextAlign = fmTextAlignCenter\n            .ForeColor = OutColorOn\n            '.BorderStyle = fmBorderStyleSingle\n        End With\n        With .LabelIn\n            .height = itemCls.SizeIn\n            .width = itemCls.SizeIn\n            .Font.Size = itemCls.SizeIn * 0.75\n            .Font.Name = FONT_NAME_ICON\n            .Caption = itemCls.IconCodeInOn\n            .TextAlign = fmTextAlignCenter\n            .ForeColor = InColorOn\n            .BackStyle = fmBackStyleTransparent\n            '.BorderStyle = fmBorderStyleSingle\n\n            .top = itemCls.LabelMain.top + (itemCls.SizeOut - itemCls.SizeIn) / 2 + 0.5\n            .left = itemCls.LabelMain.left + (itemCls.SizeOut - itemCls.SizeIn) / 2\n        End With\n\n        .LabelMain.ZOrder 0\n        .Visible = itemCls.LabelOut.Visible\n        .Enabled = itemCls.LabelOut.Enabled\n\n        If Me.Items Is Nothing Then Set mItems = New Collection\n        Set .Items = mItems\n        Call .Items.Add(itemCls, .LabelMain.Name)\n    End With\nEnd Sub\n\nPrivate Sub mLabelMain_Click()\n    Call Change(Me)\nEnd Sub\n\nPrivate Sub Change(ByRef item As clsButtonIcon)\n    With item.LabelOut\n        If .Caption <> item.IconCodeOutOn Then\n            .Caption = item.IconCodeOutOn\n        Else\n            .Caption = item.IconCodeOutOff\n        End If\n        If .ForeColor <> item.ColorOutOn Then\n            .ForeColor = item.ColorOutOn\n        Else\n            .ForeColor = item.ColorOutOff\n        End If\n    End With\n    With item.LabelIn\n        If .Caption <> item.IconCodeInOn Then\n            .Caption = item.IconCodeInOn\n        Else\n            .Caption = item.IconCodeInOff\n        End If\n        If .ForeColor <> item.ColorInOn Then\n            .ForeColor = item.ColorInOn\n        Else\n            .ForeColor = item.ColorInOff\n        End If\n    End With\nEnd Sub", 
      "CODE": "    Private clsBI       As clsButtonIcon\r\n    Set clsBI = New clsButtonIcon\r\n    Call clsBI.addItem", 
      "DISCRIPTION": "Создание кнопки с иконкой"
    }, 
    {
      "CODE_GRUP": "Forms", 
      "CODE_SNIPPET": "clsCalendarDate", 
      "clsCalendarDate.cls": "\n''========================================================================================\n' Class:           clsModernStyle\n' Author:          VBATools\n' Version:         1.0.1\n' Creation Date:   18.11.2025 15:28\n' Update Date:     18.11.2025 15:28\n'========================================================================================\nPublic Enum enTypeCalendar\n    enDay = 0\n    enMount\n    enYear\nEnd Enum\n\nPublic Enum enIconCalendar\n    icCalendar = 59271\n    icCalendarDay = 59583\n    icCalendarMirrored = 60712\n    icCalendarReply = 59637\n    icCalendarSolid = 60041\n    icCalendarWeek = 59584\nEnd Enum\n\nPrivate WithEvents mTextBox As MSForms.TextBox\nPrivate WithEvents mLbBtn As MSForms.Label\nPrivate WithEvents mParent As MSForms.UserForm\n\nPrivate frmCalendar As frmDatepickerform\nPrivate mForeColorTitle As XlRgbColor\nPrivate mFormatDate As String\nPrivate mRightBtn   As Boolean\nPrivate mTypeCalendar As enTypeCalendar\nPrivate mColorSelectedDate As XlRgbColor\nPrivate mColorMove  As XlRgbColor\nPrivate mForeColorDayYes As XlRgbColor\nPrivate mForeColorDayNo As XlRgbColor\nPrivate mMinDate As Date\nPrivate mMaxDate As Date\n\n' Property: Version\n' Purpose: Gets version information about the class\nPublic Property Get Version() As String\n    Version = \"Version: 1.0.1\" & vbNewLine & _\n            \"Author: VBATools\" & vbNewLine & _\n            \"License: Apache\" & vbNewLine & _\n            \"Date of creation: 18.11.2025 15:28\" & vbNewLine & _\n            \"Date of update: 18.11.2025 15:28\"\nEnd Property\n\nPublic Property Get TypeCalendar() As enTypeCalendar\n    TypeCalendar = mTypeCalendar\nEnd Property\n\nPublic Property Let TypeCalendar(ByVal TypeCalendar As enTypeCalendar)\n    mTypeCalendar = TypeCalendar\nEnd Property\n\nPublic Property Get ChoseDate() As Date\n    If IsDate(mTextBox.Value) Then\n        ChoseDate = VBA.CDate(mTextBox.Value)\n    End If\nEnd Property\n\nPublic Property Let ChoseDate(ByVal dtDate As Date)\n    If IsDate(dtDate) Then\n        mTextBox.Value = dtDate\n    End If\nEnd Property\n\nPublic Property Get ForeColorDayNo() As XlRgbColor\n    ForeColorDayNo = mForeColorDayNo\nEnd Property\n\nPublic Property Let ForeColorDayNo(ByVal Color As XlRgbColor)\n    ForeColorDayNo = Color\nEnd Property\n\nPublic Property Get ForeColorDayYes() As XlRgbColor\n    ForeColorDayYes = mForeColorDayYes\nEnd Property\n\nPublic Property Let ForeColorDayYes(ByVal Color As XlRgbColor)\n    mForeColorDayYes = Color\nEnd Property\n\nPublic Property Get NolorMove() As XlRgbColor\n    NolorMove = mColorMove\nEnd Property\n\nPublic Property Let NolorMove(ByVal Color As XlRgbColor)\n    mColorMove = Color\nEnd Property\n\nPublic Property Get ColorSelectedDate() As XlRgbColor\n    ColorSelectedDate = mColorSelectedDate\nEnd Property\n\nPublic Property Let ColorSelectedDate(ByVal Color As XlRgbColor)\n    mColorSelectedDate = Color\nEnd Property\n\nPublic Property Get ForeColorTitle() As XlRgbColor\n    ForeColorTitle = mForeColorTitle\nEnd Property\n\nPublic Property Let ForeColorTitle(ByVal Color As XlRgbColor)\n    mForeColorTitle = Color\nEnd Property\n\nPublic Property Get ForeColorBtn() As XlRgbColor\n    ForeColorBtn = mLbBtn.ForeColor\nEnd Property\n\nPublic Property Let ForeColorBtn(ByVal Color As XlRgbColor)\n    mLbBtn.ForeColor = Color\nEnd Property\n\nPublic Property Get IconCode() As Long\n    IconCode = VBA.Asc(mLbBtn.Caption)\nEnd Property\n\nPublic Property Let IconCode(ByVal IconCode As Long)\n    mLbBtn.Caption = VBA.ChrW$(IconCode)\nEnd Property\n\nPublic Property Get FormatDate() As String\n    FormatDate = mFormatDate\nEnd Property\n\nPublic Property Let FormatDate(ByVal FormatDate As String)\n    mFormatDate = FormatDate\nEnd Property\n\nPublic Property Get VisibleBtn() As Boolean\n    VisibleBtn = mLbBtn.Visible\nEnd Property\n\nPublic Property Let VisibleBtn(ByVal Value As Boolean)\n    mLbBtn.Visible = Value\nEnd Property\n\nPublic Property Get RightBtn() As Boolean\n    RightBtn = mRightBtn\nEnd Property\n\nPublic Property Let RightBtn(ByVal RightBtn As Boolean)\n    mRightBtn = RightBtn\n    If RightBtn Then\n        mLbBtn.Left = mTextBox.Left + mTextBox.Width\n    Else\n        mLbBtn.Left = mTextBox.Left - mLbBtn.Width\n    End If\nEnd Property\n\nPublic Sub addDatePicker(ByRef TextBox As MSForms.TextBox, _\n        Optional SetDate As Date = 0, _\n        Optional minDate As Date = 0, _\n        Optional maxDate As Date = 0, _\n        Optional TypeCalendar As enTypeCalendar = enTypeCalendar.enDay, _\n        Optional FormatDate As String = vbNullString, _\n        Optional ForeColorBtn As XlRgbColor = rgbBlack, _\n        Optional RightBtn As Boolean = True, _\n        Optional VisibleBtn As Boolean = True, _\n        Optional ForeColorTitle As XlRgbColor = &H80&, _\n        Optional IconCode As enIconCalendar = enIconCalendar.icCalendar, _\n        Optional NolorSelectedDate As XlRgbColor = 12632319, _\n        Optional ColorMove As XlRgbColor = 14737632, _\n        Optional ForeColorDayYes As XlRgbColor = rgbBlack, _\n        Optional ForeColorDayNo As XlRgbColor = 8421504)\n        \n    If minDate > maxDate Then\n        Call Err.Raise(vbObjectError + 101, \"clsCalendarDate\", \"the minimum date:[ & MinDate & ] is greater than the maximum:[ & MaxDate & ]\")\n        Exit Sub\n    End If\n\n    Set mTextBox = TextBox\n    Set mParent = mTextBox.Parent\n    With mTextBox\n        Set mLbBtn = mParent.Controls.Add(\"Forms.label.1\", .Name & \"_lb_btn\", True)\n    End With\n\n    mForeColorTitle = ForeColorTitle\n    mFormatDate = VBA.LCase$(FormatDate)\n    mColorSelectedDate = NolorSelectedDate\n    mColorMove = ColorMove\n    mForeColorDayYes = ForeColorDayYes\n    mForeColorDayNo = ForeColorDayNo\n    mMinDate = minDate\n    mMaxDate = maxDate\n\n    Select Case TypeCalendar\n        Case enTypeCalendar.enDay\n            If mFormatDate = vbNullString Then mFormatDate = \"dd.mm.yyyy\"\n            If SetDate = 0 Then SetDate = VBA.Date()\n            mTextBox.Value = VBA.Format$(SetDate, mFormatDate)\n        Case enTypeCalendar.enMount\n            If SetDate = 0 Then\n                mTextBox.Value = VBA.Month(VBA.Date())\n            Else\n                mTextBox.Value = VBA.Month(SetDate)\n            End If\n            Select Case mFormatDate\n                Case \"mm\"\n                    mTextBox.Value = VBA.MonthName(mTextBox.Value, True)\n                Case \"mmmm\"\n                    mTextBox.Value = VBA.MonthName(mTextBox.Value, False)\n            End Select\n        Case enTypeCalendar.enYear\n            mFormatDate = vbNullString\n            If SetDate = 0 Then\n                mTextBox.Value = VBA.Year(VBA.Date())\n            Else\n                mTextBox.Value = VBA.Year(SetDate)\n            End If\n    End Select\n\n    mRightBtn = RightBtn\n    mTypeCalendar = TypeCalendar\n\n    With mLbBtn\n        .Height = mTextBox.Height\n        .Width = .Height\n        .Font.Size = .Height * 0.65\n        .Font.Name = \"Segoe MDL2 Assets\"\n        .Caption = VBA.ChrW$(IconCode)\n        .TextAlign = fmTextAlignCenter\n        .BackStyle = fmBackStyleTransparent\n        .Font.Bold = True\n        .ForeColor = ForeColorBtn\n        .Top = mTextBox.Top + 2\n        If RightBtn Then\n            .Left = mTextBox.Left + mTextBox.Width\n        Else\n            .Left = mTextBox.Left - .Width\n        End If\n        .ZOrder 0\n        .Visible = VisibleBtn\n    End With\nEnd Sub\n\nPrivate Sub mTextBox_DblClick(ByVal Cancel As MSForms.ReturnBoolean)\n    Cancel = True\n    Call SetValueTextBox\nEnd Sub\n\nPrivate Sub mLbBtn_Click()\n    Call SetValueTextBox\nEnd Sub\n\nPrivate Sub SetValueTextBox()\n    Dim sVal        As String\n    Set frmCalendar = New frmDatepickerform\n    With frmCalendar\n        .redBG.BackColor = mForeColorTitle\n        sVal = mTextBox.Value\n        If sVal = vbNullString Then sVal = VBA.Date()\n        If Not IsDate(sVal) Then sVal = VBA.Date()\n        .DateGlobal = VBA.CDate(sVal)\n        .pickerMode = mTypeCalendar\n        .ColorSelectedDate = mColorSelectedDate\n        .ColorMove = mColorMove\n        .ForeColorDayYes = mForeColorDayYes\n        .ForeColorDayNo = mForeColorDayNo\n        .lbMinDate = mMinDate\n        .lbMaxDate = mMaxDate\n\n        Select Case mTypeCalendar\n            Case enTypeCalendar.enDay\n                .lbTypeCalendar.Caption = 0\n            Case enTypeCalendar.enMount\n                .lbTypeCalendar.Caption = 1\n                .iSelectGlobal = VBA.Month(VBA.Date())\n            Case enTypeCalendar.enYear\n                .lbTypeCalendar.Caption = 1\n                .iSelectGlobal = VBA.Year(VBA.Date())\n        End Select\n\n        Call .Show(1)\n        sVal = .lbDateChose.Caption\n        If sVal <> vbNullString Then\n            mTextBox.Value = VBA.Format$(sVal, mFormatDate)\n            If mTypeCalendar = enMount Then\n                Select Case mFormatDate\n                    Case \"mm\"\n                        mTextBox.Value = VBA.MonthName(sVal, True)\n                    Case \"mmmm\"\n                        mTextBox.Value = VBA.MonthName(sVal, False)\n                End Select\n            End If\n        End If\n    End With\n    Set frmCalendar = Nothing\nEnd Sub", 
      "CODE": "Dim clDate          As clsCalendarDate\r\nSet clDate = New clsCalendarDate\r\nCall clDate.addDatePicker(TextBox1)", 
      "DISCRIPTION": "класс формирует календарь для textBox", 
      "frmDatepickerform.frm": "VERSION 5.00\n\nBegin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} frmDatepickerform \n\n   ClientHeight    =   9210\n\n   ClientLeft      =   120\n\n   ClientTop       =   465\n\n   ClientWidth     =   7545\n\n   OleObjectBlob   =   \"frmDatepickerform.frx\":0000\n\n   ShowModal       =   0   'False\n\n   StartUpPosition =   1  'CenterOwner\n\nEnd\n\nAttribute VB_Name = \"frmDatepickerform\"\n\nAttribute VB_GlobalNameSpace = False\n\nAttribute VB_Creatable = False\n\nAttribute VB_PredeclaredId = True\n\nAttribute VB_Exposed = False\n\nOption Explicit\n\n\n\nPublic DateGlobal   As Date\n\nPublic pickerMode   As Integer\n\nPublic colorWhite   As XlRgbColor\n\nPublic ColorMove    As XlRgbColor\n\nPublic ColorSelectedDate As XlRgbColor\n\nPublic ForeColorDayNo As XlRgbColor\n\nPublic ForeColorDayYes As XlRgbColor\n\n\n\nPrivate minDate     As Date\n\nPrivate maxDate     As Date\n\nPrivate iDayForm    As Integer\n\nPrivate iItem       As Integer\n\nPrivate iMounthGlobal As Integer\n\nPrivate iYearGlobal As Integer\n\nPrivate sDateGlobal As String\n\nPublic iSelectGlobal As Integer\n\nPrivate iShiftGlobal As Integer\n\n\n\nPrivate Sub monthTitle_Click()\n\n    If lbTypeCalendar.Caption = \"1\" Then Exit Sub\n\n    iSelectGlobal = iMounthGlobal\n\n    iItem = 0\n\n    SetShowPicerMode1\n\nEnd Sub\n\n\n\nPrivate Sub yearTitle_Click()\n\n    If lbTypeCalendar.Caption = \"1\" Then Exit Sub\n\n    iSelectGlobal = iYearGlobal\n\n    iItem = 0\n\n    SetShowPicerMode2\n\nEnd Sub\n\n\n\nPrivate Sub nextMonthButton_Click()\n\n    If pickerMode = 0 Then\n\n        iMounthGlobal = iMounthGlobal + 1\n\n        If iMounthGlobal > 12 Then\n\n            iMounthGlobal = 1\n\n            iYearGlobal = iYearGlobal + 1\n\n        End If\n\n        SetDayOneAndDayTwo\n\n    ElseIf pickerMode = 2 Then\n\n        iShiftGlobal = iShiftGlobal + 3\n\n        Call SetYears\n\n    End If\n\nEnd Sub\n\nPrivate Sub prevMonthButton_Click()\n\n    If pickerMode = 0 Then\n\n        iMounthGlobal = iMounthGlobal - 1\n\n        If iMounthGlobal < 1 Then\n\n            iMounthGlobal = 12\n\n            iYearGlobal = iYearGlobal - 1\n\n        End If\n\n        SetDayOneAndDayTwo\n\n    ElseIf pickerMode = 2 Then\n\n        iShiftGlobal = iShiftGlobal - 3\n\n        Call SetYears\n\n    End If\n\nEnd Sub\n\n\n\nPrivate Sub UserForm_Initialize()\n\n    colorWhite = 16777215\n\n    ColorMove = 14737632\n\n    ColorSelectedDate = 12632319\n\n    ForeColorDayNo = 8421504\n\n    ForeColorDayYes = -2147483630\n\nEnd Sub\n\n\n\nPrivate Sub UserForm_Activate()\n\n    With Me\n\n        .Width = redBG.Width\n\n        .Height = barHeight.Height\n\n    End With\n\n\n\n    minDate = VBA.CDate(lbMinDate.Caption)\n\n    maxDate = VBA.CDate(lbMaxDate.Caption)\n\n\n\n    iMounthGlobal = VBA.Month(DateGlobal)\n\n    iYearGlobal = VBA.Year(DateGlobal)\n\n\n\n    SetCapitonControlSunday\n\n    SetDayOneAndDayTwo\n\n    todayButton.Caption = VBA.WeekdayName(VBA.Weekday(VBA.Date, vbMonday)) & \", \" & VBA.day(VBA.Date) & \" \" & VBA.MonthName(VBA.Month(VBA.Date)) & \" \" & VBA.Year(VBA.Date)\n\n    timeButton.Caption = VBA.Time\n\n    Call SwitchVisibleButton(pickerMode)\n\n\n\n    With Me\n\n        .StartUpPosition = 0\n\n        .Left = Application.Left + 0.5 * (Application.Width - .Width)\n\n        .Top = Application.Top + 0.5 * (Application.Height - .Height)\n\n    End With\n\nEnd Sub\n\n\n\nPrivate Sub SetControlBackColorUnderline(day)\n\n    If iDayForm <> 0 Then\n\n        If iDayForm <> day Then\n\n            If iDayForm <= 67 Then\n\n                Me.Controls(\"daybg\" & iDayForm).BackColor = colorWhite\n\n                SwitchColorControl Me.Controls(\"daybg\" & iDayForm)\n\n            ElseIf iDayForm = 68 Then\n\n                datetimebg.BackColor = colorWhite\n\n            ElseIf iDayForm = 69 Then\n\n                monthTitle.Font.Underline = False\n\n            ElseIf iDayForm = 70 Then\n\n                yearTitle.Font.Underline = False\n\n            End If\n\n        End If\n\n    End If\n\n    If day > 0 Then\n\n        If day <= 67 Then\n\n            Me.Controls(\"daybg\" & day).BackColor = ColorMove\n\n        ElseIf day = 68 Then\n\n            datetimebg.BackColor = ColorMove\n\n        ElseIf day = 69 Then\n\n            monthTitle.Font.Underline = True\n\n        ElseIf day = 70 Then\n\n            yearTitle.Font.Underline = True\n\n        End If\n\n        iDayForm = day\n\n    End If\n\nEnd Sub\n\nPrivate Sub SetControlBackColor(itemIndex As Integer)\n\n    If iItem <> 0 Then\n\n        If iItem <> itemIndex Then\n\n            Me.Controls(\"mybg\" & iItem).BackColor = colorWhite\n\n            SwitchColorControl Me.Controls(\"mybg\" & iItem), True\n\n        End If\n\n    End If\n\n    If itemIndex > 0 Then\n\n        Me.Controls(\"mybg\" & itemIndex).BackColor = ColorMove\n\n        iItem = itemIndex\n\n    End If\n\nEnd Sub\n\nPrivate Sub UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)\n\n    SetControlBackColorUnderline 0\n\nEnd Sub\n\nPrivate Sub redBG_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)\n\n    SetControlBackColorUnderline 0\n\nEnd Sub\n\nPrivate Sub day11_Click(): SetDayGlobalFromControl 11: End Sub\n\nPrivate Sub day12_Click(): SetDayGlobalFromControl 12: End Sub\n\nPrivate Sub day13_Click(): SetDayGlobalFromControl 13: End Sub\n\nPrivate Sub day14_Click(): SetDayGlobalFromControl 14: End Sub\n\nPrivate Sub day15_Click(): SetDayGlobalFromControl 15: End Sub\n\nPrivate Sub day16_Click(): SetDayGlobalFromControl 16: End Sub\n\nPrivate Sub day17_Click(): SetDayGlobalFromControl 17: End Sub\n\nPrivate Sub daybg11_Click(): SetDayGlobalFromControl 11: End Sub\n\nPrivate Sub daybg12_Click(): SetDayGlobalFromControl 12: End Sub\n\nPrivate Sub daybg13_Click(): SetDayGlobalFromControl 13: End Sub\n\nPrivate Sub daybg14_Click(): SetDayGlobalFromControl 14: End Sub\n\nPrivate Sub daybg15_Click(): SetDayGlobalFromControl 15: End Sub\n\nPrivate Sub daybg16_Click(): SetDayGlobalFromControl 16: End Sub\n\nPrivate Sub daybg17_Click(): SetDayGlobalFromControl 17: End Sub\n\nPrivate Sub day21_Click(): SetDayGlobalFromControl 21: End Sub\n\nPrivate Sub day22_Click(): SetDayGlobalFromControl 22: End Sub\n\nPrivate Sub day23_Click(): SetDayGlobalFromControl 23: End Sub\n\nPrivate Sub day24_Click(): SetDayGlobalFromControl 24: End Sub\n\nPrivate Sub day25_Click(): SetDayGlobalFromControl 25: End Sub\n\nPrivate Sub day26_Click(): SetDayGlobalFromControl 26: End Sub\n\nPrivate Sub day27_Click(): SetDayGlobalFromControl 27: End Sub\n\nPrivate Sub daybg21_Click(): SetDayGlobalFromControl 21: End Sub\n\nPrivate Sub daybg22_Click(): SetDayGlobalFromControl 22: End Sub\n\nPrivate Sub daybg23_Click(): SetDayGlobalFromControl 23: End Sub\n\nPrivate Sub daybg24_Click(): SetDayGlobalFromControl 24: End Sub\n\nPrivate Sub daybg25_Click(): SetDayGlobalFromControl 25: End Sub\n\nPrivate Sub daybg26_Click(): SetDayGlobalFromControl 26: End Sub\n\nPrivate Sub daybg27_Click(): SetDayGlobalFromControl 27: End Sub\n\nPrivate Sub day31_Click(): SetDayGlobalFromControl 31: End Sub\n\nPrivate Sub day32_Click(): SetDayGlobalFromControl 32: End Sub\n\nPrivate Sub day33_Click(): SetDayGlobalFromControl 33: End Sub\n\nPrivate Sub day34_Click(): SetDayGlobalFromControl 34: End Sub\n\nPrivate Sub day35_Click(): SetDayGlobalFromControl 35: End Sub\n\nPrivate Sub day36_Click(): SetDayGlobalFromControl 36: End Sub\n\nPrivate Sub day37_Click(): SetDayGlobalFromControl 37: End Sub\n\nPrivate Sub daybg31_Click(): SetDayGlobalFromControl 31: End Sub\n\nPrivate Sub daybg32_Click(): SetDayGlobalFromControl 32: End Sub\n\nPrivate Sub daybg33_Click(): SetDayGlobalFromControl 33: End Sub\n\nPrivate Sub daybg34_Click(): SetDayGlobalFromControl 34: End Sub\n\nPrivate Sub daybg35_Click(): SetDayGlobalFromControl 35: End Sub\n\nPrivate Sub daybg36_Click(): SetDayGlobalFromControl 36: End Sub\n\nPrivate Sub daybg37_Click(): SetDayGlobalFromControl 37: End Sub\n\nPrivate Sub day41_Click(): SetDayGlobalFromControl 41: End Sub\n\nPrivate Sub day42_Click(): SetDayGlobalFromControl 42: End Sub\n\nPrivate Sub day43_Click(): SetDayGlobalFromControl 43: End Sub\n\nPrivate Sub day44_Click(): SetDayGlobalFromControl 44: End Sub\n\nPrivate Sub day45_Click(): SetDayGlobalFromControl 45: End Sub\n\nPrivate Sub day46_Click(): SetDayGlobalFromControl 46: End Sub\n\nPrivate Sub day47_Click(): SetDayGlobalFromControl 47: End Sub\n\nPrivate Sub daybg41_Click(): SetDayGlobalFromControl 41: End Sub\n\nPrivate Sub daybg42_Click(): SetDayGlobalFromControl 42: End Sub\n\nPrivate Sub daybg43_Click(): SetDayGlobalFromControl 43: End Sub\n\nPrivate Sub daybg44_Click(): SetDayGlobalFromControl 44: End Sub\n\nPrivate Sub daybg45_Click(): SetDayGlobalFromControl 45: End Sub\n\nPrivate Sub daybg46_Click(): SetDayGlobalFromControl 46: End Sub\n\nPrivate Sub daybg47_Click(): SetDayGlobalFromControl 47: End Sub\n\nPrivate Sub day51_Click(): SetDayGlobalFromControl 51: End Sub\n\nPrivate Sub day52_Click(): SetDayGlobalFromControl 52: End Sub\n\nPrivate Sub day53_Click(): SetDayGlobalFromControl 53: End Sub\n\nPrivate Sub day54_Click(): SetDayGlobalFromControl 54: End Sub\n\nPrivate Sub day55_Click(): SetDayGlobalFromControl 55: End Sub\n\nPrivate Sub day56_Click(): SetDayGlobalFromControl 56: End Sub\n\nPrivate Sub day57_Click(): SetDayGlobalFromControl 57: End Sub\n\nPrivate Sub daybg51_Click(): SetDayGlobalFromControl 51: End Sub\n\nPrivate Sub daybg52_Click(): SetDayGlobalFromControl 52: End Sub\n\nPrivate Sub daybg53_Click(): SetDayGlobalFromControl 53: End Sub\n\nPrivate Sub daybg54_Click(): SetDayGlobalFromControl 54: End Sub\n\nPrivate Sub daybg55_Click(): SetDayGlobalFromControl 55: End Sub\n\nPrivate Sub daybg56_Click(): SetDayGlobalFromControl 56: End Sub\n\nPrivate Sub daybg57_Click(): SetDayGlobalFromControl 57: End Sub\n\nPrivate Sub day61_Click(): SetDayGlobalFromControl 61: End Sub\n\nPrivate Sub day62_Click(): SetDayGlobalFromControl 62: End Sub\n\nPrivate Sub day63_Click(): SetDayGlobalFromControl 63: End Sub\n\nPrivate Sub day64_Click(): SetDayGlobalFromControl 64: End Sub\n\nPrivate Sub day65_Click(): SetDayGlobalFromControl 65: End Sub\n\nPrivate Sub day66_Click(): SetDayGlobalFromControl 66: End Sub\n\nPrivate Sub day67_Click(): SetDayGlobalFromControl 67: End Sub\n\nPrivate Sub daybg61_Click(): SetDayGlobalFromControl 61: End Sub\n\nPrivate Sub daybg62_Click(): SetDayGlobalFromControl 62: End Sub\n\nPrivate Sub daybg63_Click(): SetDayGlobalFromControl 63: End Sub\n\nPrivate Sub daybg64_Click(): SetDayGlobalFromControl 64: End Sub\n\nPrivate Sub daybg65_Click(): SetDayGlobalFromControl 65: End Sub\n\nPrivate Sub daybg66_Click(): SetDayGlobalFromControl 66: End Sub\n\nPrivate Sub daybg67_Click(): SetDayGlobalFromControl 67: End Sub\n\nPrivate Sub timeButton_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single): SetDayFromId 68, Button: End Sub\n\nPrivate Sub todayButton_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single): SetDayFromId 68, Button: End Sub\n\nPrivate Sub datetimebg_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single): SetDayFromId 68, Button: End Sub\n\nPrivate Sub day11_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single): SetControlBackColorUnderline 11: End Sub\n\nPrivate Sub day12_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single): SetControlBackColorUnderline 12: End Sub\n\nPrivate Sub day13_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single): SetControlBackColorUnderline 13: End Sub\n\nPrivate Sub day14_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single): SetControlBackColorUnderline 14: End Sub\n\nPrivate Sub day15_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single): SetControlBackColorUnderline 15: End Sub\n\nPrivate Sub day16_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single): SetControlBackColorUnderline 16: End Sub\n\nPrivate Sub day17_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single): SetControlBackColorUnderline 17: End Sub\n\nPrivate Sub daybg11_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single): SetControlBackColorUnderline 11: End Sub\n\nPrivate Sub daybg12_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single): SetControlBackColorUnderline 12: End Sub\n\nPrivate Sub daybg13_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single): SetControlBackColorUnderline 13: End Sub\n\nPrivate Sub daybg14_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single): SetControlBackColorUnderline 14: End Sub\n\nPrivate Sub daybg15_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single): SetControlBackColorUnderline 15: End Sub\n\nPrivate Sub daybg16_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single): SetControlBackColorUnderline 16: End Sub\n\nPrivate Sub daybg17_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single): SetControlBackColorUnderline 17: End Sub\n\nPrivate Sub day21_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single): SetControlBackColorUnderline 21: End Sub\n\nPrivate Sub day22_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single): SetControlBackColorUnderline 22: End Sub\n\nPrivate Sub day23_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single): SetControlBackColorUnderline 23: End Sub\n\nPrivate Sub day24_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single): SetControlBackColorUnderline 24: End Sub\n\nPrivate Sub day25_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single): SetControlBackColorUnderline 25: End Sub\n\nPrivate Sub day26_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single): SetControlBackColorUnderline 26: End Sub\n\nPrivate Sub day27_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single): SetControlBackColorUnderline 27: End Sub\n\nPrivate Sub daybg21_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single): SetControlBackColorUnderline 21: End Sub\n\nPrivate Sub daybg22_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single): SetControlBackColorUnderline 22: End Sub\n\nPrivate Sub daybg23_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single): SetControlBackColorUnderline 23: End Sub\n\nPrivate Sub daybg24_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single): SetControlBackColorUnderline 24: End Sub\n\nPrivate Sub daybg25_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single): SetControlBackColorUnderline 25: End Sub\n\nPrivate Sub daybg26_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single): SetControlBackColorUnderline 26: End Sub\n\nPrivate Sub daybg27_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single): SetControlBackColorUnderline 27: End Sub\n\nPrivate Sub day31_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single): SetControlBackColorUnderline 31: End Sub\n\nPrivate Sub day32_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single): SetControlBackColorUnderline 32: End Sub\n\nPrivate Sub day33_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single): SetControlBackColorUnderline 33: End Sub\n\nPrivate Sub day34_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single): SetControlBackColorUnderline 34: End Sub\n\nPrivate Sub day35_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single): SetControlBackColorUnderline 35: End Sub\n\nPrivate Sub day36_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single): SetControlBackColorUnderline 36: End Sub\n\nPrivate Sub day37_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single): SetControlBackColorUnderline 37: End Sub\n\nPrivate Sub daybg31_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single): SetControlBackColorUnderline 31: End Sub\n\nPrivate Sub daybg32_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single): SetControlBackColorUnderline 32: End Sub\n\nPrivate Sub daybg33_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single): SetControlBackColorUnderline 33: End Sub\n\nPrivate Sub daybg34_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single): SetControlBackColorUnderline 34: End Sub\n\nPrivate Sub daybg35_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single): SetControlBackColorUnderline 35: End Sub\n\nPrivate Sub daybg36_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single): SetControlBackColorUnderline 36: End Sub\n\nPrivate Sub daybg37_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single): SetControlBackColorUnderline 37: End Sub\n\nPrivate Sub day41_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single): SetControlBackColorUnderline 41: End Sub\n\nPrivate Sub day42_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single): SetControlBackColorUnderline 42: End Sub\n\nPrivate Sub day43_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single): SetControlBackColorUnderline 43: End Sub\n\nPrivate Sub day44_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single): SetControlBackColorUnderline 44: End Sub\n\nPrivate Sub day45_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single): SetControlBackColorUnderline 45: End Sub\n\nPrivate Sub day46_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single): SetControlBackColorUnderline 46: End Sub\n\nPrivate Sub day47_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single): SetControlBackColorUnderline 47: End Sub\n\nPrivate Sub daybg41_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single): SetControlBackColorUnderline 41: End Sub\n\nPrivate Sub daybg42_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single): SetControlBackColorUnderline 42: End Sub\n\nPrivate Sub daybg43_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single): SetControlBackColorUnderline 43: End Sub\n\nPrivate Sub daybg44_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single): SetControlBackColorUnderline 44: End Sub\n\nPrivate Sub daybg45_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single): SetControlBackColorUnderline 45: End Sub\n\nPrivate Sub daybg46_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single): SetControlBackColorUnderline 46: End Sub\n\nPrivate Sub daybg47_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single): SetControlBackColorUnderline 47: End Sub\n\nPrivate Sub day51_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single): SetControlBackColorUnderline 51: End Sub\n\nPrivate Sub day52_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single): SetControlBackColorUnderline 52: End Sub\n\nPrivate Sub day53_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single): SetControlBackColorUnderline 53: End Sub\n\nPrivate Sub day54_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single): SetControlBackColorUnderline 54: End Sub\n\nPrivate Sub day55_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single): SetControlBackColorUnderline 55: End Sub\n\nPrivate Sub day56_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single): SetControlBackColorUnderline 56: End Sub\n\nPrivate Sub day57_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single): SetControlBackColorUnderline 57: End Sub\n\nPrivate Sub daybg51_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single): SetControlBackColorUnderline 51: End Sub\n\nPrivate Sub daybg52_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single): SetControlBackColorUnderline 52: End Sub\n\nPrivate Sub daybg53_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single): SetControlBackColorUnderline 53: End Sub\n\nPrivate Sub daybg54_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single): SetControlBackColorUnderline 54: End Sub\n\nPrivate Sub daybg55_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single): SetControlBackColorUnderline 55: End Sub\n\nPrivate Sub daybg56_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single): SetControlBackColorUnderline 56: End Sub\n\nPrivate Sub daybg57_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single): SetControlBackColorUnderline 57: End Sub\n\nPrivate Sub day61_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single): SetControlBackColorUnderline 61: End Sub\n\nPrivate Sub day62_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single): SetControlBackColorUnderline 62: End Sub\n\nPrivate Sub day63_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single): SetControlBackColorUnderline 63: End Sub\n\nPrivate Sub day64_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single): SetControlBackColorUnderline 64: End Sub\n\nPrivate Sub day65_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single): SetControlBackColorUnderline 65: End Sub\n\nPrivate Sub day66_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single): SetControlBackColorUnderline 66: End Sub\n\nPrivate Sub day67_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single): SetControlBackColorUnderline 67: End Sub\n\nPrivate Sub daybg61_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single): SetControlBackColorUnderline 61: End Sub\n\nPrivate Sub daybg62_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single): SetControlBackColorUnderline 62: End Sub\n\nPrivate Sub daybg63_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single): SetControlBackColorUnderline 63: End Sub\n\nPrivate Sub daybg64_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single): SetControlBackColorUnderline 64: End Sub\n\nPrivate Sub daybg65_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single): SetControlBackColorUnderline 65: End Sub\n\nPrivate Sub daybg66_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single): SetControlBackColorUnderline 66: End Sub\n\nPrivate Sub daybg67_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single): SetControlBackColorUnderline 67: End Sub\n\nPrivate Sub datetimebg_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single): SetControlBackColorUnderline 68: End Sub\n\nPrivate Sub monthTitle_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single): SetControlBackColorUnderline 69: End Sub\n\nPrivate Sub yearTitle_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single): SetControlBackColorUnderline 70: End Sub\n\nPrivate Sub my1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single): SetControlBackColor 1: End Sub\n\nPrivate Sub my2_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single): SetControlBackColor 2: End Sub\n\nPrivate Sub my3_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single): SetControlBackColor 3: End Sub\n\nPrivate Sub my4_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single): SetControlBackColor 4: End Sub\n\nPrivate Sub my5_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single): SetControlBackColor 5: End Sub\n\nPrivate Sub my6_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single): SetControlBackColor 6: End Sub\n\nPrivate Sub my7_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single): SetControlBackColor 7: End Sub\n\nPrivate Sub my8_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single): SetControlBackColor 8: End Sub\n\nPrivate Sub my9_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single): SetControlBackColor 9: End Sub\n\nPrivate Sub my10_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single): SetControlBackColor 10: End Sub\n\nPrivate Sub my11_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single): SetControlBackColor 11: End Sub\n\nPrivate Sub my12_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single): SetControlBackColor 12: End Sub\n\nPrivate Sub mybg1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single): SetControlBackColor 1: End Sub\n\nPrivate Sub mybg2_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single): SetControlBackColor 2: End Sub\n\nPrivate Sub mybg3_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single): SetControlBackColor 3: End Sub\n\nPrivate Sub mybg4_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single): SetControlBackColor 4: End Sub\n\nPrivate Sub mybg5_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single): SetControlBackColor 5: End Sub\n\nPrivate Sub mybg6_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single): SetControlBackColor 6: End Sub\n\nPrivate Sub mybg7_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single): SetControlBackColor 7: End Sub\n\nPrivate Sub mybg8_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single): SetControlBackColor 8: End Sub\n\nPrivate Sub mybg9_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single): SetControlBackColor 9: End Sub\n\nPrivate Sub mybg10_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single): SetControlBackColor 10: End Sub\n\nPrivate Sub mybg11_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single): SetControlBackColor 11: End Sub\n\nPrivate Sub mybg12_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single): SetControlBackColor 12: End Sub\n\nPrivate Sub myFrame_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single): SetControlBackColor 0: End Sub\n\nPrivate Sub my1_Click(): SetMountYearFormIdControl 1: End Sub\n\nPrivate Sub my2_Click(): SetMountYearFormIdControl 2: End Sub\n\nPrivate Sub my3_Click(): SetMountYearFormIdControl 3: End Sub\n\nPrivate Sub my4_Click(): SetMountYearFormIdControl 4: End Sub\n\nPrivate Sub my5_Click(): SetMountYearFormIdControl 5: End Sub\n\nPrivate Sub my6_Click(): SetMountYearFormIdControl 6: End Sub\n\nPrivate Sub my7_Click(): SetMountYearFormIdControl 7: End Sub\n\nPrivate Sub my8_Click(): SetMountYearFormIdControl 8: End Sub\n\nPrivate Sub my9_Click(): SetMountYearFormIdControl 9: End Sub\n\nPrivate Sub my10_Click(): SetMountYearFormIdControl 10: End Sub\n\nPrivate Sub my11_Click(): SetMountYearFormIdControl 11: End Sub\n\nPrivate Sub my12_Click(): SetMountYearFormIdControl 12: End Sub\n\nPrivate Sub mybg1_Click(): SetMountYearFormIdControl 1: End Sub\n\nPrivate Sub mybg2_Click(): SetMountYearFormIdControl 2: End Sub\n\nPrivate Sub mybg3_Click(): SetMountYearFormIdControl 3: End Sub\n\nPrivate Sub mybg4_Click(): SetMountYearFormIdControl 4: End Sub\n\nPrivate Sub mybg5_Click(): SetMountYearFormIdControl 5: End Sub\n\nPrivate Sub mybg6_Click(): SetMountYearFormIdControl 6: End Sub\n\nPrivate Sub mybg7_Click(): SetMountYearFormIdControl 7: End Sub\n\nPrivate Sub mybg8_Click(): SetMountYearFormIdControl 8: End Sub\n\nPrivate Sub mybg9_Click(): SetMountYearFormIdControl 9: End Sub\n\nPrivate Sub mybg10_Click(): SetMountYearFormIdControl 10: End Sub\n\nPrivate Sub mybg11_Click(): SetMountYearFormIdControl 11: End Sub\n\nPrivate Sub mybg12_Click(): SetMountYearFormIdControl 12: End Sub\n\n'-------------------------------------------------------------------------\n\nPrivate Sub SwitchColorControl(objControl As control, Optional picker As Boolean = False)\n\n    If objControl.BackColor = ColorSelectedDate Then\n\n        objControl.BackColor = colorWhite\n\n    End If\n\n    If picker Then\n\n        If iSelectGlobal = objControl.Tag Then\n\n            objControl.BackColor = ColorSelectedDate\n\n        End If\n\n    Else\n\n        If DateGlobal = objControl.Tag Then\n\n            objControl.BackColor = ColorSelectedDate\n\n        End If\n\n    End If\n\nEnd Sub\n\nPrivate Sub SetCapitonControlSunday()\n\n    Dim i           As Byte\n\n    For i = 1 To 7\n\n        Me.Controls(\"dayofweek\" & i).Caption = VBA.WeekdayName(i, True, vbMonday)\n\n    Next i\n\nEnd Sub\n\n\n\nPrivate Sub SetDayFromId(id As Integer, Button As Integer)\n\n    If Button > 1 Then\n\n        SetDayGlobalFromControl 68, True\n\n    Else\n\n        SetDayGlobalFromControl 68\n\n    End If\n\nEnd Sub\n\nPrivate Sub SetDayGlobalFromControl(id As Integer, Optional inculdeTime As Boolean = False)\n\n    If id <= 67 Then\n\n        sDateGlobal = Me.Controls(\"day\" & id).Tag\n\n    ElseIf id = 68 Then\n\n        sDateGlobal = VBA.Date\n\n        If inculdeTime Then sDateGlobal = sDateGlobal & \" \" & VBA.Time\n\n    End If\n\n    lbDateChose.Caption = sDateGlobal\n\n    Me.Hide\n\nEnd Sub\n\nPrivate Sub SetMountYearFormIdControl(id As Integer)\n\n    If lbTypeCalendar.Caption = \"1\" Then\n\n        lbDateChose.Caption = Me.Controls(\"my\" & id).Tag\n\n        Me.Hide\n\n        Exit Sub\n\n    End If\n\n    If pickerMode = 1 Then\n\n        iMounthGlobal = Me.Controls(\"my\" & id).Tag\n\n    ElseIf pickerMode = 2 Then\n\n        iYearGlobal = Me.Controls(\"my\" & id).Tag\n\n\n\n        If minDate <> 0 And iYearGlobal = VBA.Year(minDate) Then\n\n            If iMounthGlobal < VBA.Month(minDate) Then iMounthGlobal = VBA.Month(minDate)\n\n        End If\n\n\n\n        If maxDate <> 0 And iYearGlobal = VBA.Year(maxDate) Then\n\n            If iMounthGlobal > VBA.Month(maxDate) Then iMounthGlobal = VBA.Month(maxDate)\n\n        End If\n\n    End If\n\n    SetDayOneAndDayTwo\n\n    SwitchVisibleButton 0\n\nEnd Sub\n\n\n\nPrivate Sub SetShowPicerMode1()\n\n    If pickerMode = 1 Then\n\n        SwitchVisibleButton 0\n\n    Else\n\n        SwitchVisibleButton 1\n\n        FrameTop30\n\n    End If\n\nEnd Sub\n\n\n\nPrivate Sub SetShowPicerMode2()\n\n    If pickerMode = 2 Then\n\n        SwitchVisibleButton 0\n\n    Else\n\n        SwitchVisibleButton 2\n\n        FrameTop30\n\n    End If\n\nEnd Sub\n\n\n\nPrivate Sub FrameTop30()\n\n    myFrame.Top = 30\n\nEnd Sub\n\n\n\nPrivate Sub FrameTopHeight()\n\n    myFrame.Top = Me.Height\n\nEnd Sub\n\n\n\nPrivate Sub SwitchVisibleButton(Mode As Integer)\n\n    If Mode = 0 Then\n\n        pickerMode = 0\n\n        FrameTopHeight\n\n        Call subVisibleButtonMount(True)\n\n    ElseIf Mode = 1 Then\n\n        Call SetMounts\n\n        Call subVisibleButtonMount(False)\n\n        pickerMode = 1\n\n        Call FrameTop30\n\n    ElseIf Mode = 2 Then\n\n        iShiftGlobal = -6\n\n        Call SetYears\n\n        Call subVisibleButtonMount(True)\n\n        pickerMode = 2\n\n        Call FrameTop30\n\n    End If\n\nEnd Sub\n\n\n\nPrivate Sub blockBtn(Mode As Integer)\n\n    If Mode = 0 Then\n\n        prevMonthButton.Enabled = day11.Enabled\n\n        nextMonthButton.Enabled = day67.Enabled\n\n    ElseIf Mode = 1 Then\n\n        prevMonthButton.Enabled = myBG1.Enabled\n\n        nextMonthButton.Enabled = myBG12.Enabled\n\n    ElseIf Mode = 2 Then\n\n\n\n    End If\n\nEnd Sub\n\n\n\nPrivate Sub SetDayOneAndDayTwo()\n\n    Dim dtDate1     As Date\n\n    Dim dtDate2     As Date\n\n    Dim iDay        As Integer\n\n    Dim objCnt1     As control\n\n    Dim objCnt2     As control\n\n    Dim i           As Byte\n\n    Dim j           As Byte\n\n\n\n    dtDate1 = VBA.DateSerial(iYearGlobal, iMounthGlobal, 1)\n\n    iDay = VBA.Weekday(dtDate1, vbMonday)\n\n    dtDate2 = VBA.DateAdd(\"d\", -iDay + 1, dtDate1)\n\n    Me.monthTitle.Caption = VBA.MonthName(VBA.Month(dtDate1), True)\n\n    Me.yearTitle.Caption = VBA.Year(dtDate1)\n\n    For i = 1 To 6\n\n        For j = 1 To 7\n\n            Set objCnt1 = Me.Controls(\"day\" & i & j)\n\n            Set objCnt2 = Me.Controls(\"dayBG\" & i & j)\n\n            objCnt1.Caption = VBA.day(dtDate2)\n\n            objCnt1.Tag = dtDate2\n\n            objCnt2.Tag = dtDate2\n\n\n\n\n\n            objCnt1.Enabled = Not ((dtDate2 < minDate And minDate <> 0) Or (dtDate2 > maxDate And maxDate <> 0))\n\n            objCnt2.Enabled = objCnt1.Enabled\n\n\n\n            If VBA.Month(dtDate2) <> iMounthGlobal Then\n\n                objCnt1.ForeColor = ForeColorDayNo\n\n            Else\n\n                objCnt1.ForeColor = ForeColorDayYes\n\n            End If\n\n            SwitchColorControl objCnt2\n\n            dtDate2 = VBA.DateAdd(\"d\", 1, dtDate2)\n\n        Next j\n\n    Next i\n\n    Call blockBtn(0)\n\nEnd Sub\n\n\n\nPrivate Sub SetMounts()\n\n    Dim objCnt1     As control\n\n    Dim objCnt2     As control\n\n    Dim i           As Byte\n\n    Dim minMonth    As Byte\n\n    Dim maxMonth    As Byte\n\n    Dim minYear     As Integer\n\n    Dim maxYear     As Integer\n\n\n\n    minMonth = VBA.Month(minDate)\n\n    maxMonth = VBA.Month(maxDate)\n\n    minYear = VBA.Year(minDate)\n\n    maxYear = VBA.Year(maxDate)\n\n    For i = 1 To 12\n\n        Set objCnt1 = Me.Controls(\"my\" & i)\n\n        Set objCnt2 = Me.Controls(\"mybg\" & i)\n\n        objCnt1.Caption = VBA.MonthName(i, True)\n\n        objCnt1.Tag = i\n\n        objCnt2.Tag = i\n\n\n\n        objCnt1.Enabled = Not ((i < minMonth And minDate <> 0 And iYearGlobal = minYear) Or (i > maxMonth And maxDate <> 0 And iYearGlobal = maxYear))\n\n        objCnt2.Enabled = objCnt1.Enabled\n\n\n\n        objCnt2.BackColor = colorWhite\n\n        SwitchColorControl objCnt2, True\n\n    Next i\n\nEnd Sub\n\n\n\nPrivate Sub SetYears()\n\n    Dim objCnt1     As control\n\n    Dim objCnt2     As control\n\n    Dim iYear       As Integer\n\n    Dim i           As Byte\n\n\n\n    iYear = iYearGlobal + iShiftGlobal\n\n    For i = 1 To 12\n\n        Set objCnt1 = Me.Controls(\"my\" & i)\n\n        Set objCnt2 = Me.Controls(\"mybg\" & i)\n\n        objCnt1.Caption = iYear\n\n        objCnt1.Tag = iYear\n\n        objCnt2.Tag = iYear\n\n\n\n        objCnt1.Enabled = Not ((iYear < VBA.Year(minDate) And minDate <> 0) Or (iYear > VBA.Year(maxDate) And maxDate <> 0))\n\n        objCnt2.Enabled = objCnt1.Enabled\n\n        objCnt2.BackColor = colorWhite\n\n        SwitchColorControl objCnt2, True\n\n        iYear = iYear + 1\n\n    Next i\n\n    Call blockBtn(1)\n\nEnd Sub\n\n\n\nPrivate Sub subVisibleButtonMount(ByVal Value As Boolean)\n\n    prevMonthButton.Visible = Value\n\n    nextMonthButton.Visible = Value\n\nEnd Sub\n\n\n\n", 
      "frmDatepickerform.frx": "TEIIAABUAAAAAAAAAAAAAGkeAABDJgAA0M8R4KGxGuEAAAAAAAAAAAAAAAAAAAAAPgADAP7/\nCQAGAAAAAAAAAAAAAAABAAAACQAAAAAAAAAAEAAAFQAAAAEAAAD+////AAAAAAoAAAD/////\n////////////////////////////////////////////////////////////////////////\n////////////////////////////////////////////////////////////////////////\n////////////////////////////////////////////////////////////////////////\n////////////////////////////////////////////////////////////////////////\n////////////////////////////////////////////////////////////////////////\n////////////////////////////////////////////////////////////////////////\n////////////////////////////////////////////////////////////////////////\n//////////////////////////////////////////////////////////////////9iABUA\nZGl2aWRlcnMAAAAAdRoAAAAALAD1AQAACwAAgIkAAAAyAAAASAAAAGMAFQB0b2RheUJ1dHRv\nbminAQAAmB4AAAAAKAD1AQAABgAAgIsAAAAyAAAAVAAAAGUAFQBMYWJlbDFyc1MWAAAdHAAA\nAAAkANUBAAAHAACAjAAAACMABABmAA4AbXlGcmFtZQAAAAAAjiMAAAAALAD1AQAACwAAgKkA\nAAAyAAAAMAAAAGcAFQBsYkRhdGVDaG9zZQA1JQAAewIAAAAAMAD1AQAADgAAgKsAAAAyAAAA\nOAAAAGgAFQBsYlR5cGVDYWxlbmRhcgCANSUAAEUIAAAAACwA9QEAAAkAAICsAAAAMgAAADgA\nAABpABUAbGJNaW5EYXRlAAAANSUAADsNAAAAACwA9QEAAAkAAICtAAAAMgAAADgAAABqABUA\nbGJNYXhEYXRlaWdoNSUAADESAAAAAgwAGQAAAPN/AQD/AQAAcQcAAAAAKAD1AQAABQAAgBkA\nAAAyAAAASAAAAAkAFQBkYXkxNHJpAA4OAABxBwAAAAAoAPUBAAAHAACAGgAAADIAAAA8AAAA\nCgAVAGRheWJnMTcAoRkAAJ0GAAAAACgA9QEAAAcAAIAcAAAAMgAAADwAAAALABUAZGF5Ymcx\nNQBdEQAAnQYAAAAAKAD1AQAABQAAgB0AAAAyAAAASAAAAAwAFQBkYXkxNUZCXzESAABxBwAA\nAAAoAPUBAAAHAACAHgAAADIAAAA8AAAADQAVAGRheWJnMTYAfxUAAJ0GAAAAACgA9QEAAAUA\nAIAfAAAAMgAAAEgAAAAOABUAZGF5MTYxMQBSFgAAcQcAAAAAKAD1AQAABQAAgCAAAAAyAAAA\nSAAAAA8AFQBkYXkxN3JpAHUaAABxBwAAAAAsAPUBAAAJAACAIQAAADIAAABIAAAAEAAVAHll\nYXJUaXRsZWlnaJ0GAADUAAAAAAAoAPUBAAAHAACAIgAAADIAAAA8AAAAEQAVAGRheWJnMjcA\noRkAAOwJAAAAACgA9QEAAAcAAIAjAAAAMgAAADwAAAASABUAZGF5YmcyMQDUAAAA7AkAAAAA\nKAD1AQAABwAAgCQAAAAyAAAAPAAAABMAFQBkYXliZzIyc/YEAADsCQAAAAAoAPUBAAAFAACA\nJQAAADIAAABIAAAAFAAVAGRheTIxAAAApwEAAMAKAAAAACgA9QEAAAUAAIAmAAAAMgAAAEgA\nAAAVABUAZGF5MjL5XCvKBQAAwAoAAAAAKAD1AQAABwAAgCcAAAAyAAAAPAAAABYAFQBkYXli\nZzI0ADsNAADsCQAAAAAoAPUBAAAHAACAKAAAADIAAAA8AAAAFwAVAGRheWJnMjMAGAkAAOwJ\nAAAAACgA9QEAAAUAAIApAAAAMgAAAEgAAAAYABUAZGF5MjMAAADrCQAAwAoAAAAAKAD1AQAA\nBQAAgCoAAAAyAAAASAAAABkAFQBkYXkyNAAAAA4OAADACgAAAAAoAPUBAAAHAACAKwAAADIA\nAAA8AAAAGgAVAGRheWJnMjVzXREAAOwJAAAAACgA9QEAAAUAAIAsAAAAMgAAAEgAAAAbABUA\nZGF5MjUxNF8xEgAAwAoAAAAAKAD1AQAABwAAgC0AAAAyAAAAPAAAABwAFQBkYXliZzI2X38V\nAADsCQAAAAAoAPUBAAAFAACALgAAADIAAABIAAAAHQAVAGRheTI2AAAAUhYAAMAKAAAAACgA\n9QEAAAUAAIAvAAAAMgAAAEgAAAAeABUAZGF5MjcyMwB1GgAAwAoAAAAAKAD1AQAABwAAgDAA\nAAAyAAAAPAAAAB8AFQBkYXliZzM3AKEZAAA6DQAAAAAoAPUBAAAHAACAMQAAADIAAAA8AAAA\nIAAVAGRheWJnMzEA1AAAADoNAAAAACgA9QEAAAcAAIAyAAAAMgAAADwAAAAhABUAZGF5Ymcz\nMnP2BAAAOg0AAAAAKAD1AQAABQAAgDMAAAAyAAAASAAAACIAFQBkYXkzMQAAAKcBAAAODgAA\nAAAoAPUBAAAFAACANAAAADIAAABIAAAAIwAVAGRheTMyAAAAygUAAA4OAAAAACgA9QEAAAcA\nAIA1AAAAMgAAADwAAAAkABUAZGF5YmczNF87DQAAOg0AAAAAKAD1AQAABwAAgDYAAAAyAAAA\nPAAAACUAFQBkYXliZzMzABgJAAA6DQAAAAAoAPUBAAAFAACANwAAADIAAABIAAAAJgAVAGRh\neTMzAAAA6wkAAA4OAAAAACgA9QEAAAUAAIA4AAAAMgAAAEgAAAAnABUAZGF5MzRyaSQODgAA\nDg4AAAAAKAD1AQAABwAAgDkAAAAyAAAAPAAAACgAFQBkYXliZzM1AF0RAAA6DQAAAAAoAPUB\nAAAFAACAOgAAADIAAABIAAAAKQAVAGRheTM1AAAAMRIAAA4OAAAAACgA9QEAAAcAAIA7AAAA\nMgAAADwAAAAqABUAZGF5YmczNgB/FQAAOg0AAAAAKAD1AQAABQAAgDwAAAAyAAAASAAAACsA\nFQBkYXkzNgAAAFIWAAAODgAAAAAoAPUBAAAFAACAPQAAADIAAABIAAAALAAVAGRheTM3AAAA\ndRoAAA4OAAAAACgA9QEAAAcAAIA+AAAAMgAAADwAAAAtABUAZGF5Ymc0NwChGQAAiRAAAAAA\nKAD1AQAABwAAgD8AAAAyAAAAPAAAAC4AFQBkYXliZzQxANQAAACJEAAAAAAoAGJyaSBMaWdo\ndAAAgAACFACiAAAA////AODg4AAjBAAATwMAAAACIAC1AAAADQAAgKUAAAAAAiwBQ2FsaWJy\naSBMaWdodAAAgAACHAAuAAAAwMD/ABMAgAACAACAMjlFAHsCAACnAQAAAAIkAPUAAAANAACA\n4QAAAAACAwAsAQAAQ2FsaWJyaSBMaWdodAAAgAACHAAuAAAAwMD/ABMAgAACAACAMjmdKnsC\nAACnAQAAAAIkAPUAAAANAACA4QAAAAACAwAsAQAAQ2FsaWJyaSBMaWdodAAAgAACFACiAAAA\n////AODg4AAjBAAATwMAAAACIAC1AAAADQAAgKUAAAAAAiwBQ2FsaWJyaSBMaWdodAAAgAAC\nFACiAAAA////AODg4AAjBAAATwMAAAACIAC1AAAADQAAgKUAAAAAAiwBQ2FsaWJyaSBMaWdo\ndAAAgAACFACiAAAA////AODg4AAjBAAATwMAAAACIAC1AAAADQAAgKUAAAAAAiwBQ2FsaWJy\naSBMaWdodFTkHgACHAAuAAAAwMD/ABMAgAACAACAMjkAAHsCAACnAQAAAAIkAPUAAAANAACA\n4QAAAAACAwAsAQAAQ2FsaWJyaSBMaWdodAAAAAACHAAuAAAAwMD/ABMAgAACAACAMjlFAHsC\nAACnAQAAAAIkAPUAAAANAACA4QAAAAACAwAsAQAAQ2FsaWJyaSBMaWdodAAAAAACFACiAAAA\n////AODg4AAjBAAATwMAAAACIAC1AAAADQAAgKUAAAAAAiwBQ2FsaWJyaSBMaWdodEroNwAC\nFACiAAAA////AODg4AAjBAAATwMAAAACIAC1AAAADQAAgKUAAAAAAiwBQ2FsaWJyaSBMaWdo\ndFTkHgACHAAuAAAAwMD/ABMAgAACAACAMjkAAHsCAACnAQAAAAIkAPUAAAANAACA4QAAAAAC\nAwAsAQAAQ2FsaWJyaSBMaWdodFTkHgACHAAuAAAAwMD/ABMAgAACAACAMjlCX3sCAACnAQAA\nAAIkAPUAAAANAACA4QAAAAACAwAsAQAAQ2FsaWJyaSBMaWdodAAAgAACFACiAAAA////AODg\n4AAjBAAATwMAAAACIAC1AAAADQAAgKUAAAAAAiwBQ2FsaWJyaSBMaWdodAAAgAACHAAuAAAA\nwMD/ABMAgAACAACAMjlFAHsCAACnAQAAAAIkAPUAAAANAACA4QAAAAACAwAsAQAAQ2FsaWJy\naSBMaWdodAAAgAACFACiAAAA////AODg4AAjBAAATwMAAAACIAC1AAAADQAAgKUAAAAAAiwB\nQ2FsaWJyaSBMaWdodEroNwACHAAuAAAAwMD/ABMAgAACAACAMjlFAHsCAACnAQAAAAIkAPUA\nAAANAACA4QAAAAACAwAsAQAAQ2FsaWJyaSBMaWdodEroNwACHAAuAAAAwMD/ABMAgAACAACA\nMjmdKnsCAACnAQAAAAIkAPUAAAANAACA4QAAAAACAwAsAQAAQ2FsaWJyaSBMaWdodAAAgAAC\nIAAvAAAA////AMDA/wATAIAAAQAAgFM5AAB7AgAApwEAAAACJAD1AAAADQAAgLQAAAAAAgMA\nLAEAAENhbGlicmkgTGlnaHQAAAAAAiAALwAAAP///wDAwP8AEwCAAAEAAIBNOUUAewIAAKcB\nAAAAAiQA9QAAAA0AAIC0AAAAAAIDACwBAABDYWxpYnJpIExpZ2h0Sug3AAIgAC8AAAD///8A\nwMD/ABMAgAABAACAVDlFAHsCAACnAQAAAAIkAPUAAAANAACAtAAAAAACAwAsAQAAQ2FsaWJy\naSBMaWdodAAAAAACIAAvAAAA////AMDA/wATAIAAAQAAgFcAAAB7AgAApwEAAAACJAD1AAAA\nDQAAgLQAAAAAAgMALAEAAENhbGlicmkgTGlnaHQAAIAAAiAALwAAAP///wDAwP8AEwCAAAEA\nAIBUAAAAewIAAKcBAAAAAiQA9QAAAA0AAIC0AAAAAAIDACwBAABDYWxpYnJpIExpZ2h0AACA\nAAIgAC8AAAD///8AwMD/ABMAgAABAACARgAAAHsCAACnAQAAAAIkAPUAAAANAACAtAAAAAAC\nAwAsAQAAQ2FsaWJyaSBMaWdodAAAgAACIAAvAAAA////AMDA/wATAIAAAQAAgFM5RQB7AgAA\npwEAAAACJAD1AAAADQAAgLQAAAAAAgMALAEAAENhbGlicmkgTGlnaHRU5B4AAhQAogAAAIAA\nAACAAAAAtQ8AABIlAAAAAhgANQAAAAcAAIClAAAAAAIAAENhbGlicmkAAAIgAC8AAAD///8A\ngAAAABMAgAABAACANWFsaXsCAAB7AgAAAAIYAHUAAAAIAACAHQEAAAICAwBXZWJkaW5ncwAC\nIAAvAAAA////AIAAAAATAIAAAQAAgDY5AAB7AgAAewIAAAACGAB1AAAACAAAgB0BAAACAgMA\nV2ViZGluZ3MAAhQAogAAAP///wDg4OAAxB0AAMoFAAAAAhgANQAAAAcAAIClAAAAAAIAAENh\nbGlicmkrAAIcAC4AAADAwP8AEwCAAAQAAIBUaW1lSRsAAHsCAAAAAiAAtQAAAA0AAIAdAQAA\nAAIsAUNhbGlicmkgTGlnaHRU5B4AAhgAogEAAP///wDg4OAAAQAAABMhAAAjAAAAAAIgALUA\nAAANAACApQAAAAACLAFDYWxpYnJpIExpZ2h0VOQeAAIgAC8AAACAgIAAwMD/ABMAgAAEAACA\nRGF0ZUkbAACnAQAAAAIgALUAAAANAACA4QAAAAACLAFDYWxpYnJpIExpZ2h0Sug3AAIsAC8A\nAACAgIAAwMD/ABMAgAAOAAAAIQQ1BDMEPgQ0BD0ETwQAgJ0GAACnAQAAAAIgALUAAAANAACA\n4QAAAAACLAFDYWxpYnJpIExpZ2h0AACAAAIQACIAAAD///8AZwwAACIEAAAAAhgANQAAAAcA\nAIClAAAAAAIAAENhbGlicmkAAAIYACoAAAD///8AAQAAgDB5QkdnDAAATgMAAAACGAA1AAAA\nBwAAgKUAAAAAAgAAQ2FsaWJyaQAAAhgAKgAAAP///wABAACAMABFAGcMAABOAwAAAAIYADUA\nAAAHAACApQAAAAACAABDYWxpYnJpcwACGAAqAAAA////AAEAAIAwYWxpZwwAAE4DAAAAAhgA\nNQAAAAcAAIClAAAAAAIAAENhbGlicmkkTwMAAAACIAC1AAAADQAAgKUAAAAAAiwBQ2FsaWJy\naSBMaWdodAAAgAACHAAuAAAAwMD/ABMAgAACAACAMjlFAHsCAACnAQAAAAIkAPUAAAANAACA\n4QAAAAACAwAsAQAAQ2FsaWJyaSBMaWdodFTkHgACHAAuAAAAwMD/ABMAgAACAACAMjlFAHsC\nAACnAQAAAAIkAPUAAABSAG8AbwB0ACAARQBuAHQAcgB5AAAAAAAAAAAAAAAAAAAAAAAAAAAA\nAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAFgAFAP//////////AgAAAPBpKsbcFs4RnpgAqgBX\nSk8AAAAAAAAAAAAAAACg8qpXZWPcARYAAAAADAAAAAAAAGYAAAAAAAAAAAAAAAAAAAAAAAAA\nAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAEAAIB////////\n////////AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAIAAAAGwTAAAAAAAA\nbwAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA\nAAAAAAAAAAAAAAQAAgEBAAAAAwAAAP////8AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA\nAAAAAAAAAAAMAAAAaBsAAAAAAABpADEANAAwAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA\nAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACgABAf////8HAAAABQAAACAgGG5g9M4R\nm80AqgBgjgEAAAAAEJOpV2Vj3AEguqlXZWPcAQAAAAAAAAAAAAAAAP7/////////////////\n//8FAAAABgAAAAcAAAAIAAAA/v///wsAAAD9/////v///w0AAAAOAAAADwAAABAAAAARAAAA\nEgAAABMAAAAUAAAABAAAAP7///8XAAAAGAAAABkAAAAaAAAAGwAAAP7/////////////////\n////////IQAAACIAAAAjAAAAJAAAACUAAAAmAAAAJwAAACgAAAAAAAAA////////////////\n////////////////////////////////////////////////////////////////////////\n////////////////////////////////////////////////////////////////////////\n////////////////////////////////////////////////////////////////////////\n////////////////////////////////////////////////////////////////////////\n////////////////////////////////////////////////////////////////////////\n////////////////////////////////////////////////////////////////////////\n////////////////ZgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA\nAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAQAAgD///////////////8AAAAAAAAAAAAAAAAAAAAA\nAAAAAAAAAAAAAAAAAAAAAAAAAAAfAAAAPAQAAAAAAABvAAAAAAAAAAAAAAAAAAAAAAAAAAAA\nAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABAACAQQAAAAGAAAA\n/////wAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAQAAADABgAAAAAAAAEA\nQwBvAG0AcABPAGIAagAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA\nAAAAAAAAAAASAAIA////////////////AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA\nAAAAAAAAAgAAAHAAAAAAAAAAAQBDAG8AbQBwAE8AYgBqAAAAAAAAAAAAAAAAAAAAAAAAAAAA\nAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABIAAgD///////////////8AAAAAAAAAAAAA\nAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAbgAAAAAAAAAAAhgAowAAAP///wCAAAAA\ngAAAAAIfAACdBgAAAAIYADUAAAAHAACApQAAAAACAABDYWxpYnJpAAACFACiAAAA////AODg\n4AAjBAAATwMAAAACIAC1AAAADQAAgKUAAAAAAiwBQ2FsaWJyaSBMaWdodFTkHgACFACiAAAA\n////AODg4AAjBAAATwMAAAACIAC1AAAADQAAgKUAAAAAAiwBQ2FsaWJyaSBMaWdodAAAAAAC\nIAAvAAAA////AIAAAAATAIAAAwAAgE5PVmkjBAAAewIAAAACIAC1AAAADQAAgDsBAAAAAiwB\nQ2FsaWJyaSBMaWdodAAAgAACIAAvAAAAgICAAMDA/wATAIAAAgAAgDI5RQB7AgAApwEAAAAC\nJAD1AAAADQAAgOEAAAAAAgMALAEAAENhbGlicmkgTGlnaHQAAIAAAhwALgAAAMDA/wATAIAA\nAgAAgDI5AAB7AgAApwEAAAACJAD1AAAADQAAgOEAAAAAAgMALAEAAENhbGlicmkgTGlnaHQA\nAIAAAhQAogAAAP///wDg4OAAIwQAAE8DAAAAAiAAtQAAAA0AAIClAAAAAAIsAUNhbGlicmkg\nTGlnaHQAAIAAAhQAogAAAP///wDg4OAAIwQAAE8DAAAAAiAAtQAAAA0AAIClAAAAAAIsAUNh\nbGlicmkgTGlnaHQAAIAAAhwALgAAAMDA/wATAIAAAgAAgDI5nSp7AgAApwEAAAACJAD1AAAA\nDQAAgOEAAAAAAgMALAEAAENhbGlicmkgTGlnaHQAAIAAAhwALgAAAMDA/wATAIAAAgAAgDI5\nRQB7AgAApwEAAAACJAD1AAAADQAAgOEAAAAAAgMALAEAAENhbGlicmkgTGlnaHQAAIAAAhQA\nogAAAP///wDg4OAAIwQAAE8DAAAAAiAAtQAAAA0AAIClAAAAAAIsAUNhbGlicmkgTGlnaHQA\nAIAAAhQAogAAAP///wDg4OAAIwQAAE8DAAAAAiAAtQAAAA0AAIClAAAAAAIsAUNhbGlicmkg\nTGlnaHQAAIAAAhwALgAAAMDA/wATAIAAAgAAgDI5QwB7AgAApwEAAAACJAD1AAAADQAAgOEA\nAAAAAgMALAEAAENhbGlicmkgTGlnaHQAAIAAAhQAogAAAP///wDg4OAAIwQAAE8DAAAAAiAA\ntQAAAA0AAIClAAAAAAIsAUNhbGlicmkgTGlnaHQAAIAAAhwALgAAAMDA/wATAIAAAgAAgDI5\nHit7AgAApwEAAAACJAD1AAAADQAAgOEAAAAAAgMALAEAAENhbGlicmkgTGlnaHQAAIAAAhwA\nLgAAAMDA/wATAIAAAgAAgDI5RQB7AgAApwEAAAACJAD1AAAADQAAgOEAAAAAAgMALAEAAENh\nbGlicmkgTGlnaHRU5B4AAiAALwAAAP///wCAAAAAEwCAAAQAAIAyMDE1yQUAAHsCAAAAAiAA\ntQAAAA0AAIA7AQAAAAIsAUNhbGlicmkgTGlnaHQAAIAAAhQAogAAAP///wDg4OAAIwQAAE8D\nAAAAAiAAtQAAAA0AAIClAAAAAAIsAUNhbGlicmkgTGlnaHQAAIAAAhQAogAAAP///wDg4OAA\nIwQAAE8DAAAAAiAAtQAAAA0AAIClAAAAAAIsAUNhbGlicmkgTGlnaHRU5B4AAhQAogAAAP//\n/wDg4OAAIwQAAE8DAAAAAiAAtQAAAA0AAIClAAAAAAIsAUNhbGlicmkgTGlnaHQAAIAAAhwA\nLgAAAMDA/wATAIAAAgAAgDI5RQB7AgAApwEAAAACJAD1AAAADQAAgOEAAAAAAgMALAEAAENh\nbGlicmkgTGlnaHQAAIAAAhwALgAAAMDA/wATAIAAAgAAgDI5RQB7AgAApwEAAAACJAD1AAAA\nDQAAgOEAAAAAAgMALAEAAENhbGlicmkgTGlnaHQAAIAAAhQAogAAAP///wDg4OAAIwQAAE8D\nAAAAAiAAtQAAAA0AAIClAAAAAAIsAUNhbGlicmkgTGlnaHQAAIAAAhQAogAAAP///wDg4OAA\nIwQAAE8DAAAAAiAAtQAAAA0AAIClAAAAAAIsAUNhbGlicmkgTGlnaHRK6DcAAhwALgAAAMDA\n/wATAIAAAgAAgDI5Vml7AgAApwEAAAACJAD1AAAADQAAgOEAAAAAAgMALAEAAENhbGlicmkg\nTGlnaHQAAIAAAhwALgAAAMDA/wATAIAAAgAAgDI5RQB7AgAApwEAAAACJAD1AAAADQAAgOEA\nAAAAAgMALAEAAENhbGlicmkgTGlnaHQAAIAAAhQAogAAAP///wDg4OAAIwQAAE8DAAAAAiAA\ntQAAAA0AAIClAAAAAAIsAUNhbGlicmkgTGlnaHRU5B4AAhwALgAAAMDA/wATAIAAAgAAgDI5\nRQB7AgAApwEAAAACJAD1AAAADQAAgOEAAAAAAgMALAEAAENhbGlicmkgTGlnaHQAAIAAAhQA\nogAAAP///wDg4OAAIwQAAE8DAAAAAiAAtQAAAA0AAIClAAAAAAIsAUNhbGlicmkgTGlnaHQA\nAIAAAhwALgAAAMDA/wATAIAAAgAAgDI5Hit7AgAApwEAAAACJAD1AAAADQAAgOEAAAAAAgMA\nLAEAAENhbGlicmkgTGlnaHRK6DcAAhwALgAAAMDA/wATAIAAAgAAgDI5nSp7AgAApwEAAAAC\nJAD1AAAADQAAgOEAAAAAAgMALAEAAENhbGlicmkgTGlnaHQAAAAAAhQAogAAAP///wDg4OAA\nIwQAAE8DAAAAAiAAtQAAAA0AAIClAAAAAAIsAUNhbGlicmkgTGlnaHQAAAAAAhQAogAAAP//\n/wDg4OAAIwQAAE8DAAAAAiAAtQAAAA0AAIClAAAAAAIsAUNhbGlicmkgTGlnaHQAAIAAAhQA\nogAAAP///wDg4OAAIwQAAE8DAAAAAiAAtQAAAA0AAIClAAAAAAIsAUNhbGlicmkgTGlnaHQA\nAIAAAhwALgAAAMDA/wATAIAAAgAAgDI5nSp7AgAApwEAAAACJAD1AAAADQAAgOEAAAAAAgMA\nLAEAAENhbGlicmkgTGlnaHQAAIAAAhwALgAAAMDA/wATAIAAAgAAgDI5Hit7AgAApwEAAAAC\nJAD1AAAADQAAgOEAAAAAAgMALAEAAENhbGlicmkgTGlnaHQAAIAAAhQAogAAAP///wDg4OAA\nIwQAAE8DAAAAAiAAtQAAAA0AAIClAAAAAAIsAUNhbGlicmkgTGlnaHRU5B4AAhQAogAAAP//\n/wDg4OAAIwQAAE8DAAAAAiAAtQAAAA0AAIClAAAAAAIsAUNhbGlicmkgTGlnaHQAAIAAAhwA\nLgAAAMDA/wATAIAAAgAAgDI5RQB7AgAApwEAAAACJAD1AAAADQAAgOEAAAAAAgMALAEAAENh\nbGlicmkgTGlnaHQAAIAAAhwALgAAAMDA/wATAIAAAgAAgDI5RQB7AgAApwEAAAACJAD1AAAA\nDQAAgOEAAAAAAgMALAEAAENhbGlicmkgTGlnaHQAAIAAAhQAogAAAP///wDg4OAAIwQAAE8D\nAAAAAiAAtQAAAA0AAIClAAAAAAIsAUNhbGlicmkgTGlnaHQAAIAAAhwALgAAAMDA/wATAIAA\nAgAAgDI5AAB7AgAApwEAAAACJAD1AAAADQAAgOEAAAAAAgMALAEAAENhbGlicmkgTGlnaHQA\nAIAAAhQAogAAAP///wDg4OAAIwQAAE8DAAAAAiAAtQAAAA0AAIClAAAAAAIsAUNhbGlicmkg\nTGlnaHQAAIAAAhwALgAAAMDA/wATAIAAAgAAgDI5RQB7AgAApwEAAAACJAD1AAAADQAAgOEA\nAAAAAgMALAEAAENhbGlicmkgTGlnaHRU5B4AAhwALgAAAMDA/wATAIAAAgAAgDI5RQB7AgAA\npwEAAAACJAD1AAAADQAAgOEAAAAAAgMALAEAAENhbGlicmkgTGlnaHQAAIAAAhQAogAAAP//\n/wDg4OAAIwQAAE8DAAAAAiAAtQAAAA0AAIClAAAAAAIsAUNhbGlicmkgTGlnaHQAAIAAAhQA\nogAAAP///wDg4OAAIwQAAE8DAAAAAiAAtQAAAA0AAIClAAAAAAIsAUNhbGlicmkgTGlnaHQA\nAIAAAhQAogAAAP///wDg4OAAIwQAAE8DAAAAAiAAtQAAAA0AAIClAAAAAAIsAUNhbGlicmkg\nTGlnaHRU5B4AAhwALgAAAMDA/wATAIAAAgAAgDI5RQB7AgAApwEAAAACJAD1AAAADQAAgOEA\nAAAAAgMALAEAAENhbGlicmkgTGlnaHQAAIAAAhwALgAAAMDA/wATAIAAAgAAgDI5Hit7AgAA\npwEAAAACJAD1AAAADQAAgOEAAAAAAgMALAEAAENhbGlicmkgTGlnaHRU5B4AAhQAogAAAP//\n/wDg4OAAIwQAAE8DAAAAAiAAtQAAAA0AAIClAAAAAAIsAUNhbGlicmkgTGlnaHRU5B4AAhQA\nogAAAP///wDg4OAAIwQAAE8DAAAAAiAAtQAAAA0AAIClAAAAAAIsAUNhbGlicmkgTGlnaHRU\n5B4AAhwALgAAAMDA/wATAIAAAgAAgDI5RQB7AgAApwEAAAACJAD1AAAADQAAgOEAAAAAAgMA\nLAEAAENhbGlicmkgTGlnaHQAAAAAAhwALgAAAMDA/wATAIAAAgAAgDI5AAB7AgAApwEAAAAC\nJAD1AAAADQAAgOEAAAAAAgMALAEAAENhbGlicmkgTGlnaHRU5B4AAhQAogAAAP///wDg4OAA\nIwQAAE8DAAAAAiAAtQAAAA0AAIClAAAAAAIsAUNhbGlicmkgTGlnaHRU5B4AAhwALgAAAMDA\n/wATAIAAAgAAgDI5RQB7AgAApwEAAAACJAD1AAAADQAAgOEAAAAAAgMALAEAAENhbGlicmkg\nTGlnaHQAAAAAAhQAogAAAP///wDg4OAAIwQAAE8DAAAAAiAAtQAAAA0AAIClAAAAAAIsAUNh\nbGlicmkgTGlnaHQAAAAAAhwALgAAAMDA/wATAIAAAgAAgDI5AAB7AgAApwEAAAACJAD1AAAA\nDQAAgOEAAAAAAgMALAEAAENhbGlicmkgTGlnaHQAAIAAAhwALgAAAMDA/wATAIAAAgAAgDI5\nQwB7AgAApwEAAAACJAD1AAAADQAAgOEAAAAAAgMALAEAAENhbGlicmkgTGlnaHRU5B4AAhQA\nogAAAP///wDg4OAAIwQAAE8DAAAAAiAAtQAAAA0AAIClAAAAAAIsAUNhbGlicmkgTGlnaHRU\n5B4AAhQAogAAAP///wDg4OAAIwQAAE8DAAAAAiAAtQAAAA0AAIClAAAAAAIsAUNhbGlicmkg\nTGlnaHRU5B4AAhQAogAAAP///wDg4OAAIwQAAE8DAAAAAiAAtQAAAA0AAIClAAAAAAIsAUNh\nbGlicmkgTGlnaHQAAIAAAhwALgAAAMDA/wATAIAAAgAAgDI5RQB7AgAApwEAAAACJAD1AAAA\nDQAAgOEAAAAAAgMALAEAAENhbGlicmkgTGlnaHRK6DcAAhwALgAAAMDA/wATAIAAAgAAgDI5\nnSp7AgAApwEAAAACJAD1AAAADQAAgOEAAAAAAgMALAEAAENhbGlicmkgTGlnaHQAAIAAAhQA\nogAAAP///wDg4OAAIwQAAE8DAAAAAiAAtQAAAA0AAIClAAAAAAIsAUNhbGlicmkgTGlnaHRU\n5B4AAhQAogAAAP///wDg4OAAIwQAAE8DAAAAAiAAtQAAAA0AAIClAAAAAAIsAUNhbGlicmkg\nTGlnaHRK6DcAAhwALgAAAMDA/wATAIAAAgAAgDI5RQB7AgAApwEAAAACJAD1AAAADQAAgOEA\nAAAAAgMALAEAAENhbGlicmkgTGlnaHRU5B4AAhwALgAAAMDA/wATAIAAAgAAgDI5RQB7AgAA\npwEAAAACJAD1AAAADQAAgOEAAAAAAgMALAEAAENhbGlicmkgTGlnaHQAAIAAAhQAogAAAP//\n/wDg4OAAIwQAAE8DAAAAAiAAtQAAAA0AAIClAAAAAAIsAUNhbGlicmkgTGlnaHQAAIAAAhwA\nLgAAAMDA/wATAIAAAgAAgDI5AAB7AgAApwEAAAACJAD1AAAADQAAgOEAAAAAAgMALAEAAENh\nbGkBAAAA/v///wMAAAD+////BQAAAAYAAAAHAAAACAAAAAkAAAAKAAAACwAAAAwAAAANAAAA\nDgAAAA8AAAAQAAAAEQAAABIAAAATAAAAFAAAABUAAAAWAAAAFwAAABgAAAAZAAAAGgAAABsA\nAAAcAAAAHQAAAB4AAAD+////IAAAACEAAAAiAAAAIwAAACQAAAAlAAAAJgAAACcAAAAoAAAA\nKQAAACoAAAArAAAALAAAAC0AAAAuAAAALwAAAP7/////////////////////////////////\n////////////////////////////////////////////////////////////////////////\n////////////////////////////////////////////////////////////////////////\n////////////////////////////////////////////////////////////////////////\n////////////////////////////////////////////////////////////////////////\n////////////////////////////////////////////////////////////////////////\n/////////////////////////////////////wEA/v8DCgAA//////BpKsbcFs4RnpgAqgBX\nSk8ZAAAATWljcm9zb2Z0IEZvcm1zIDIuMCBGb3JtABAAAABFbWJlZGRlZCBPYmplY3QADQAA\nAEZvcm1zLkZvcm0uMQD0ObJxAAAAAAAAAAAAAAAAAAAyAAAAOAAAAAEAFQByZWRCAQD+/wMK\nAAD/////ICAYbmD0zhGbzQCqAGCOARoAAABNaWNyb3NvZnQgRm9ybXMgMi4wIEZyYW1lABAA\nAABFbWJlZGRlZCBPYmplY3QADgAAAEZvcm1zLkZyYW1lLjEA9DmycQAAAAAAAAAAAAAAAHRU\n5B4AAhQAogAAAP///wAAAhgAogEAAP///wDg4OAAAQAAAEQIAADJBQAAAAIkAPUAAAANAACA\nHQEAAAACAwAsAQAAQ2FsaWJyaSBMaWdodAAAgAACGACiAQAA////AODg4AABAAAARAgAAMkF\nAAAAAiQA9QAAAA0AAIAdAQAAAAIDACwBAABDYWxpYnJpIExpZ2h0AACAAAIYAKIBAAD///8A\n4ODgAAEAAABECAAAyQUAAAACJAD1AAAADQAAgB0BAAAAAgMALAEAAENhbGlicmkgTGlnaHRU\n5B4AAhgAogEAAP///wDg4OAAAQAAAEQIAADKBQAAAAIkAPUAAAANAACAHQEAAAACAwAsAQAA\nQ2FsaWJyaSBMaWdodADkHgACGACiAQAA////AODg4AABAAAARAgAAMoFAAAAAiQA9QAAAA0A\nAIAdAQAAAAIDACwBAABDYWxpYnJpIExpZ2h0AACAAAIYAKIBAAD///8A4ODgAAEAAABECAAA\nygUAAAACJAD1AAAADQAAgB0BAAAAAgMALAEAAENhbGlicmkgTGlnaHRU5B4AAhgAogEAAP//\n/wDg4OAAAQAAAEQIAADKBQAAAAIkAPUAAAANAACAHQEAAAACAwAsAQAAQ2FsaWJyaSBMaWdo\ndEroNwACGACiAQAA////AODg4AABAAAARAgAAMoFAAAAAiQA9QAAAA0AAIAdAQAAAAIDACwB\nAABDYWxpYnJpIExpZ2h0AACAAAIYAKIBAAD///8A4ODgAAEAAABECAAAygUAAAACJAD1AAAA\nDQAAgB0BAAAAAgMALAEAAENhbGlicmkgTGlnaHQAAAAAAhgAogEAAP///wDg4OAAAQAAAEQI\nAADJBQAAAAIkAPUAAAANAACAHQEAAAACAwAsAQAAQ2FsaWJyaSBMaWdodAAAAAACGACiAQAA\n////AODg4AABAAAARAgAAMkFAAAAAiQA9QAAAA0AAIAdAQAAAAIDACwBAABDYWxpYnJpIExp\nZ2h0AACAAAIYAKIBAAD///8A4ODgAAEAAABECAAAyQUAAAACJAD1AAAADQAAgB0BAAAAAgMA\nLAEAAENhbGlicmkgTGlnaHQAAIAAAiAArgAAAP///wATAIAAAwAAgODg4ABKQU4qngYAAHsC\nAAAAAiQA9QAAAA0AAIAdAQAAAAIDACwBAABDYWxpYnJpIExpZ2h0AACAAAIgAK4AAAD///8A\nEwCAAAMAAIDg4OAASkFOK54GAAB7AgAAAAIkAPUAAAANAACAHQEAAAACAwAsAQAAQ2FsaWJy\naSBMaWdodAAAgAACIACuAAAA////ABMAgAADAACA4ODgAEpBTgCeBgAAewIAAAACJAD1AAAA\nDQAAgB0BAAAAAgMALAEAAENhbGlicmkgTGlnaHQAAIAAAiAArgAAAP///wATAIAAAwAAgODg\n4ABKQU4AngYAAHsCAAAAAiQA9QAAAA0AAIAdAQAAAAIDACwBAABDYWxpYnJpIExpZ2h0AACA\nAAIgAK4AAAD///8AEwCAAAMAAIDg4OAASkFOaZ4GAAB7AgAAAAIkAPUAAAANAACAHQEAAAAC\nAwAsAQAAQ2FsaWJyaSBMaWdodAAAgAACIACuAAAA////ABMAgAADAACA////AEpBTgCeBgAA\newIAAAACJAD1AAAADQAAgB0BAAAAAgMALAEAAENhbGlicmkgTGlnaHQAAIAAAiAArgAAAP//\n/wATAIAAAwAAgODg4ABKQU4rngYAAHsCAAAAAiQA9QAAAA0AAIAdAQAAAAIDACwBAABDYWxp\nYnJpIExpZ2h0Sug3AAIgAK4AAAD///8AEwCAAAMAAIDg4OAASkFOKp4GAAB7AgAAAAIkAPUA\nAAANAACAHQEAAAACAwAsAQAAQ2FsaWJyaSBMaWdodAAAgAACIACuAAAA////ABMAgAADAACA\n4ODgAEpBTgCeBgAAewIAAAACJAD1AAAADQAAgB0BAAAAAgMALAEAAENhbGlicmkgTGlnaHRU\n5B4AAiAArgAAAP///wATAIAAAwAAgODg4ABKQU4AngYAAHsCAAAAAiQA9QAAAA0AAIAdAQAA\nAAIDACwBAABDYWxpYnJpIExpZ2h0AACAAAIgAK4AAAD///8AEwCAAAMAAIDg4OAASkFOKp4G\nAAB7AgAAAAIkAPUAAAANAACAHQEAAAACAwAsAQAAQ2FsaWJyaSBMaWdodAAAgAACIACuAAAA\n////ABMAgAADAACA4ODgAEpBTgCeBgAAewIAAAACJAD1AAAADQAAgB0BAAAAAgMALAEAAENh\nbGlicmkgTGlnaHRU5B4ABCwASg4ADP///wCoAAAABMAAAAAAAAA7AAAAAH0AAD8gAADEHQAA\nAAAAAAAAAAAYAAAA9AMAAACYAVAAACgA9QEAAAUAAICNAAAAMgAAAEQAAAAAABUAbXlCRzEA\nAACnAQAApwEAAAAAKAD1AQAABQAAgI4AAAAyAAAARAAAAAEAFQBteUJHMgAAAL8KAACnAQAA\nAAAoAPUBAAAFAACAjwAAADIAAABEAAAAAgAVAG15Qkczbmdz2BMAAKcBAAAAACgA9QEAAAUA\nAICQAAAAMgAAAEQAAAADABUAbXlCRzRCQl+nAQAARAgAAAAAKAD1AQAABQAAgJEAAAAyAAAA\nRAAAAAQAFQBteUJHNUJCX78KAABECAAAAAAoAPUBAAAFAACAkgAAADIAAABEAAAABQAVAG15\nQkc2AAAA2BMAAEQIAAAAACgA9QEAAAUAAICTAAAAMgAAAEQAAAAGABUAbXlCRzkAAADYEwAA\n4Q4AAAAAKAD1AQAABQAAgJQAAAAyAAAARAAAAAcAFQBteUJHOAAAAL8KAADhDgAAAAAoAPUB\nAAAFAACAlQAAADIAAABEAAAACAAVAG15Qkc3AAAApwEAAOEOAAAAACgA9QEAAAYAAICWAAAA\nMgAAAEQAAAAJABUAbXlCRzExAAC/CgAAfxUAAAAAKAD1AQAABgAAgJcAAAAyAAAARAAAAAoA\nFQBteUJHMTAAAKcBAAB/FQAAAAAoAPUBAAAGAACAmAAAADIAAABEAAAACwAVAG15QkcxMgAA\n2RMAAH8VAAAAACQA9QEAAAMAAICZAAAAMgAAAEwAAAAMABUAbXkxR3oCAABOAwAAAAAkAPUB\nAAADAACAmgAAADIAAABMAAAADQAVAG15Ml+TCwAATgMAAAAAJAD1AQAAAwAAgJsAAAAyAAAA\nTAAAAA4AFQBteTNprBQAAE8DAAAAACQA9QEAAAMAAICdAAAAMgAAAEwAAAAPABUAbXk1AJML\nAADrCQAAAAAkAPUBAAADAACAngAAADIAAABMAAAAEAAVAG15NGl6AgAA6wkAAAAAJAD1AQAA\nAwAAgKIAAAAyAAAATAAAABEAFQBteTYArBQAAOwJAAAAACQA9QEAAAMAAICjAAAAMgAAAEwA\nAAASABUAbXk5K6wUAACJEAAAAAAkAPUBAAADAACApAAAADIAAABMAAAAEwAVAG15OEeTCwAA\niRAAAAAAJAD1AQAAAwAAgKUAAAAyAAAATAAAABQAFQBteTdkegIAAIkQAAAAACQA9QEAAAQA\nAICmAAAAMgAAAEwAAAAVABUAbXkxMHoCAAAmFwAAAAAkAPUBAAAEAACApwAAADIAAABMAAAA\nFgAVAG15MTGTCwAAJhcAAAAAJAD1AQAABAAAgKgAAAAyAAAATAAAABcAFQBteTEyrBQAACYX\nAAAAAgwAGQAAAPN/AQD/AQAAAAAAAPUBAAAHAACAQAAAADIAAAA8AAAALwAVAGRheWJnNDIA\n9gQAAIkQAAAAACgA9QEAAAUAAIBBAAAAMgAAAEgAAAAwABUAZGF5NDFyaQCnAQAAXREAAAAA\nKAD1AQAABQAAgEIAAAAyAAAASAAAADEAFQBkYXk0MjQ3AMoFAABdEQAAAAAoAPUBAAAHAACA\nQwAAADIAAAA8AAAAMgAVAGRheWJnNDRzOw0AAIkQAAAAACgA9QEAAAcAAIBEAAAAMgAAADwA\nAAAzABUAZGF5Ymc0MwAYCQAAiRAAAAAAKAD1AQAABQAAgEUAAAAyAAAASAAAADQAFQBkYXk0\nMzQ0c+sJAABdEQAAAAAoAPUBAAAFAACARgAAADIAAABIAAAANQAVAGRheTQ0AAAADg4AAF0R\nAAAAACgA9QEAAAcAAIBHAAAAMgAAADwAAAA2ABUAZGF5Ymc0NQBdEQAAiRAAAAAAKAD1AQAA\nBQAAgEgAAAAyAAAASAAAADcAFQBkYXk0NTQ3ADESAABdEQAAAAAoAPUBAAAHAACASQAAADIA\nAAA8AAAAOAAVAGRheWJnNDYAfxUAAIkQAAAAACgA9QEAAAUAAIBKAAAAMgAAAEgAAAA5ABUA\nZGF5NDYyMwBSFgAAXREAAAAAKAD1AQAABQAAgEsAAAAyAAAASAAAADoAFQBkYXk0NzMzAHUa\nAABdEQAAAAAoAPUBAAAHAACAWgAAADIAAAA8AAAAOwAVAGRheWJnNTcAoRkAANgTAAAAACgA\n9QEAAAcAAIBbAAAAMgAAADwAAAA8ABUAZGF5Ymc1MQDUAAAA2BMAAAAAKAD1AQAABwAAgFwA\nAAAyAAAAPAAAAD0AFQBkYXliZzUyAPYEAADYEwAAAAAoAPUBAAAFAACAXQAAADIAAABIAAAA\nPgAVAGRheTUxcmkrpwEAAKwUAAAAACgA9QEAAAUAAIBeAAAAMgAAAEgAAAA/ABUAZGF5NTI1\nMgDKBQAArBQAAAAAKAD1AQAABwAAgF8AAAAyAAAAPAAAAEAAFQBkYXliZzU0ADsNAADYEwAA\nAAAoAPUBAAAHAACAYAAAADIAAAA8AAAAQQAVAGRheWJnNTMAGAkAANgTAAAAACgA9QEAAAUA\nAIBhAAAAMgAAAEgAAABCABUAZGF5NTMAAADrCQAArBQAAAAAKAD1AQAABQAAgGIAAAAyAAAA\nSAAAAEMAFQBkYXk1NAAAAA4OAACsFAAAAAAoAPUBAAAHAACAYwAAADIAAAA8AAAARAAVAGRh\neWJnNTUAXREAANgTAAAAACgA9QEAAAUAAIBkAAAAMgAAAEgAAABFABUAZGF5NTX5XCsxEgAA\nrBQAAAAAKAD1AQAABwAAgGUAAAAyAAAAPAAAAEYAFQBkYXliZzU2AH8VAADYEwAAAAAoAPUB\nAAAFAACAZgAAADIAAABIAAAARwAVAGRheTU2NTcAUhYAAKwUAAAAACgA9QEAAAUAAIBnAAAA\nMgAAAEgAAABIABUAZGF5NTcxMgB1GgAArBQAAAAAKAD1AQAABwAAgGgAAAAyAAAAPAAAAEkA\nFQBkYXliZzY3AKEZAAAmFwAAAAAoAPUBAAAHAACAaQAAADIAAAA8AAAASgAVAGRheWJnNjEr\n1AAAACYXAAAAACgA9QEAAAcAAIBqAAAAMgAAADwAAABLABUAZGF5Ymc2Miv2BAAAJhcAAAAA\nKAD1AQAABQAAgGsAAAAyAAAASAAAAEwAFQBkYXk2MTY3AKcBAAD6FwAAAAAoAPUBAAAFAACA\nbAAAADIAAABIAAAATQAVAGRheTYyMzYAygUAAPoXAAAAACgA9QEAAAcAAIBtAAAAMgAAADwA\nAABOABUAZGF5Ymc2NAA7DQAAJhcAAAAAKAD1AQAABwAAgG4AAAAyAAAAPAAAAE8AFQBkYXli\nZzYzJBgJAAAmFwAAAAAoAPUBAAAFAACAbwAAADIAAABIAAAAUAAVAGRheTYzcmkr6wkAAPoX\nAAAAACgA9QEAAAUAAIBwAAAAMgAAAEgAAABRABUAZGF5NjQzNgAODgAA+hcAAAAAKAD1AQAA\nBwAAgHEAAAAyAAAAPAAAAFIAFQBkYXliZzY1c10RAAAmFwAAAAAoAPUBAAAFAACAcgAAADIA\nAABIAAAAUwAVAGRheTY1MzRfMRIAAPoXAAAAACgA9QEAAAcAAIBzAAAAMgAAADwAAABUABUA\nZGF5Ymc2NgB/FQAAJhcAAAAAKAD1AQAABQAAgHQAAAAyAAAASAAAAFUAFQBkYXk2NjYyK1IW\nAAD6FwAAAAAoAPUBAAAFAACAdQAAADIAAABIAAAAVgAVAGRheTY3MzEAdRoAAPoXAAAAACwA\n9QEAAAoAAIB5AAAAMgAAAEwAAABXABUAZGF5b2Z3ZWVrMWdopwEAACIEAAAAACwA9QEAAAoA\nAIB6AAAAMgAAAEwAAABYABUAZGF5b2Z3ZWVrMmdoygUAACIEAAAAACwA9QEAAAoAAIB9AAAA\nMgAAAEwAAABZABUAZGF5b2Z3ZWVrM2do6wkAACIEAAAAACwA9QEAAAAAAAAAAAAAAAAAAAAA\nAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA\nAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA\nAAAAAAAAAAAAAAAAAAAAAAAAAAQsAEoOEAz///8ArQAAAARAAAAAAP//YQEAAAB9AAD9MwAA\ndT8AAAAAAAAAAAAAA1LjC5GPzhGd4wCqAEu4UQEAAACQAURCAQAHQ2FsaWJyaQAAawAAAAAT\nAAAA6wEAAAAoAPUBAAAFAACAAgAAADIAAAA4AAAAAQAVAHJlZEJHAAAAAAAAAAAAAAAAACgA\n9QEAAAcAAIAEAAAAMgAAADwAAAADABUAZGF5YmcxMQDUAAAAnQYAAAAAKAD1AQAABwAAgA8A\nAAAyAAAAPAAAAAQAFQBkYXliZzEyAPYEAACdBgAAAAAsAPUBAAAKAACAAQAAADIAAABIAAAA\nAAAVAG1vbnRoVGl0bGVnaKcBAADUAAAAAAAoAPUBAAAFAACAAwAAADIAAABMAAAAAgAVAGRh\neTExAAAApwEAAHEHAAAAACgA9QEAAAUAAIAVAAAAMgAAAEgAAAAFABUAZGF5MTIAAADKBQAA\ncQcAAAAAKAD1AQAABwAAgBYAAAAyAAAAPAAAAAYAFQBkYXliZzE0XzsNAACdBgAAAAAoAPUB\nAAAHAACAFwAAADIAAAA8AAAABwAVAGRheWJnMTMAGAkAAJ0GAAAAACgA9QEAAAUAAIAYAAAA\nMgAAAEgAAAAIABUAZGF5MTMxNF/rCQAAcQcAAAAAKAD1AQAABQAAgBkAAAAyAAAASAAAAAkA\nFQBkYXkxNHJpAA4OAABxBwAAAAAoAPUBAAAHAACAGgAAADIAAAA8AAAACgAVAGRheWJnMTcA\noRkAAJ0GAAAAACgA9QEAAAcAAIAcAAAAMgAAADwAAAALABUAZGF5YmcxNQBdEQAAnQYAAAAA\nKAD1AQAABQAAgB0AAAAyAAAASAAAAAwAFQBkYXkxNUZCXzESAABxBwAAAAAoAPUBAAAHAACA\nHgAAADIAAAA8AAAADQAVAGRheWJnMTYAfxUAAJ0GAAAAACgA9QEAAAUAAIAfAAAAMgAAAEgA\nAAAOABUAZGF5MTYxMQBSFgAAcQcAAAAAKAD1AQAABQAAgCAAAAAyAAAASAAAAA8AFQBkYXkx\nN3JpAHUaAABxBwAAAAAsAPUBAAAJAACAIQAAADIAAABIAAAAEAAVAHllYXJUaXRsZWlnaJ0G\nAADUAAAAAAAoAPUBAAAHAACAIgAAADIAAAA8AAAAEQAVAGRheWJnMjcAoRkAAOwJAAAAACgA\n9QEAAAcAAIAjAAAAMgAAADwAAAASABUAZGF5YmcyMQDUAAAA7AkAAAAAKAD1AQAABwAAgCQA\nAAAyAAAAPAAAABMAFQBkYXliZzIyc/YEAADsCQAAAAAoAPUBAAAFAACAJQAAADIAAABIAAAA\nFAAVAGRheTIxAAAApwEAAMAKAAAAACgA9QEAAAUAAIAmAAAAMgAAAEgAAAAVABUAZGF5MjL5\nXCvKBQAAwAoAAAAAKAD1AQAABwAAgCcAAAAyAAAAPAAAABYAFQBkYXliZzI0ADsNAADsCQAA\nAAAoAPUBAAAHAACAKAAAADIAAAA8AAAAFwAVAGRheWJnMjMAGAkAAOwJAAAAACgA9QEAAAUA\nAIApAAAAMgAAAEgAAAAYABUAZGF5MjMAAADrCQAAwAoAAAAAKAD1AQAABQAAgCoAAAAyAAAA\nSAAAABkAFQBkYXkyNAAAAA4OAADACgAAAAAoAPUBAAAHAACAKwAAADIAAAA8AAAAGgAVAGRh\neWJnMjVzXREAAOwJAAAAACgA9QEAAAUAAIAsAAAAMgAAAEgAAAAbABUAZGF5MjUxNF8xEgAA\nwAoAAAAAKAD1AQAABwAAgC0AAAAyAAAAPAAAABwAFQBkYXliZzI2X38VAADsCQAAAAAoAPUB\nAAAFAACALgAAADIAAABIAAAAHQAVAGRheTI2AAAAUhYAAMAKAAAAACgA9QEAAAUAAIAvAAAA\nMgAAAEgAAAAeABUAZGF5MjcyMwB1GgAAwAoAAAAAKAD1AQAABwAAgDAAAAAyAAAAPAAAAB8A\nFQBkYXliZzM3AKEZAAA6DQAAAAAoAPUBAAAHAACAMQAAADIAAAA8AAAAIAAVAGRheWJnMzEA\n1AAAADoNAAAAACgA9QEAAAcAAIAyAAAAMgAAADwAAAAhABUAZGF5YmczMnP2BAAAOg0AAAAA\nKAD1AQAABQAAgDMAAAAyAAAASAAAACIAFQBkYXkzMQAAAKcBAAAODgAAAAAoAPUBAAAFAACA\nNAAAADIAAABIAAAAIwAVAGRheTMyAAAAygUAAA4OAAAAACgA9QEAAAcAAIA1AAAAMgAAADwA\nAAAkABUAZGF5YmczNF87DQAAOg0AAAAAKAD1AQAABwAAgDYAAAAyAAAAPAAAACUAFQBkYXli\nZzMzABgJAAA6DQAAAAAoAPUBAAAFAACANwAAADIAAABIAAAAJgAVAGRheTMzAAAA6wkAAA4O\nAAAAACgA9QEAAAUAAIA4AAAAMgAAAEgAAAAnABUAZGF5MzRyaSQODgAADg4AAAAAKAD1AQAA\nBwAAgDkAAAAyAAAAPAAAACgAFQBkYXliZzM1AF0RAAA6DQAAAAAoAPUBAAAFAACAOgAAADIA\nAABIAAAAKQAVAGRheTM1AAAAMRIAAA4OAAAAACgA9QEAAAcAAIA7AAAAMgAAADwAAAAqABUA\nZGF5YmczNgB/FQAAOg0AAAAAKAD1AQAABQAAgDwAAAAyAAAASAAAACsAFQBkYXkzNgAAAFIW\nAAAODgAAAAAoAPUBAAAFAACAPQAAADIAAABIAAAALAAVAGRheTM3AAAAdRoAAA4OAAAAACgA\n9QEAAAcAAIA+AAAAMgAAADwAAAAtABUAZGF5Ymc0NwChGQAAiRAAAAAAKAD1AQAABwAAgD8A\nAAAyAAAAPAAAAC4AFQBkYXliZzQxANQAAACJEAAAAAAoAPUBAAAHAACAQAAAADIAAAA8AAAA\nLwAVAGRheWJnNDIA9gQAAIkQAAAAACgA9QEAAAUAAIBBAAAAMgAAAEgAAAAwABUAZGF5NDFy\naQCnAQAAXREAAAAAKAD1AQAABQAAgEIAAAAyAAAASAAAADEAFQBkYXk0MjQ3AMoFAABdEQAA\nAAAoAPUBAAAHAACAQwAAADIAAAA8AAAAMgAVAGRheWJnNDRzOw0AAIkQAAAAACgA9QEAAAcA\nAIBEAAAAMgAAADwAAAAzABUAZGF5Ymc0MwAYCQAAiRAAAAAAKAD1AQAABQAAgEUAAAAyAAAA\nSAAAADQAFQBkYXk0MzQ0c+sJAABdEQAAAAAoAPUBAAAFAACARgAAADIAAABIAAAANQAVAGRh\neTQ0AAAADg4AAF0RAAAAACgA9QEAAAcAAIBHAAAAMgAAADwAAAA2ABUAZGF5Ymc0NQBdEQAA\niRAAAAAAKAD1AQAABQAAgEgAAAAyAAAASAAAADcAFQBkYXk0NTQ3ADESAABdEQAAAAAoAPUB\nAAAHAACASQAAADIAAAA8AAAAOAAVAGRheWJnNDYAfxUAAIkQAAAAACgA9QEAAAUAAIBKAAAA\nMgAAAEgAAAA5ABUAZGF5NDYyMwBSFgAAXREAAAAAKAD1AQAABQAAgEsAAAAyAAAASAAAADoA\nFQBkYXk0NzMzAHUaAABdEQAAAAAoAPUBAAAHAACAWgAAADIAAAA8AAAAOwAVAGRheWJnNTcA\noRkAANgTAAAAACgA9QEAAAcAAIBbAAAAMgAAADwAAAA8ABUAZGF5Ymc1MQDUAAAA2BMAAAAA\nKAD1AQAABwAAgFwAAAAyAAAAPAAAAD0AFQBkYXliZzUyAPYEAADYEwAAAAAoAPUBAAAFAACA\nXQAAADIAAABIAAAAPgAVAGRheTUxcmkrpwEAAKwUAAAAACgA9QEAAAUAAIBeAAAAMgAAAEgA\nAAA/ABUAZGF5NTI1MgDKBQAArBQAAAAAKAD1AQAABwAAgF8AAAAyAAAAPAAAAEAAFQBkYXli\nZzU0ADsNAADYEwAAAAAoAPUBAAAHAACAYAAAADIAAAA8AAAAQQAVAGRheWJnNTMAGAkAANgT\nAAAAACgA9QEAAAUAAIBhAAAAMgAAAEgAAABCABUAZGF5NTMAAADrCQAArBQAAAAAKAD1AQAA\nBQAAgGIAAAAyAAAASAAAAEMAFQBkYXk1NAAAAA4OAACsFAAAAAAoAPUBAAAHAACAYwAAADIA\nAAA8AAAARAAVAGRheWJnNTUAXREAANgTAAAAACgA9QEAAAUAAIBkAAAAMgAAAEgAAABFABUA\nZGF5NTX5XCsxEgAArBQAAAAAKAD1AQAABwAAgGUAAAAyAAAAPAAAAEYAFQBkYXliZzU2AH8V\nAADYEwAAAAAoAPUBAAAFAACAZgAAADIAAABIAAAARwAVAGRheTU2NTcAUhYAAKwUAAAAACgA\n9QEAAAUAAIBnAAAAMgAAAEgAAABIABUAZGF5NTcxMgB1GgAArBQAAAAAKAD1AQAABwAAgGgA\nAAAyAAAAPAAAAEkAFQBkYXliZzY3AKEZAAAmFwAAAAAoAPUBAAAHAACAaQAAADIAAAA8AAAA\nSgAVAGRheWJnNjEr1AAAACYXAAAAACgA9QEAAAcAAIBqAAAAMgAAADwAAABLABUAZGF5Ymc2\nMiv2BAAAJhcAAAAAKAD1AQAABQAAgGsAAAAyAAAASAAAAEwAFQBkYXk2MTY3AKcBAAD6FwAA\nAAAoAPUBAAAFAACAbAAAADIAAABIAAAATQAVAGRheTYyMzYAygUAAPoXAAAAACgA9QEAAAcA\nAIBtAAAAMgAAADwAAABOABUAZGF5Ymc2NAA7DQAAJhcAAAAAKAD1AQAABwAAgG4AAAAyAAAA\nPAAAAE8AFQBkYXliZzYzJBgJAAAmFwAAAAAoAPUBAAAFAACAbwAAADIAAABIAAAAUAAVAGRh\neTYzcmkr6wkAAPoXAAAAACgA9QEAAAUAAIBwAAAAMgAAAEgAAABRABUAZGF5NjQzNgAODgAA\n+hcAAAAAKAD1AQAABwAAgHEAAAAyAAAAPAAAAFIAFQBkYXliZzY1c10RAAAmFwAAAAAoAPUB\nAAAFAACAcgAAADIAAABIAAAAUwAVAGRheTY1MzRfMRIAAPoXAAAAACgA9QEAAAcAAIBzAAAA\nMgAAADwAAABUABUAZGF5Ymc2NgB/FQAAJhcAAAAAKAD1AQAABQAAgHQAAAAyAAAASAAAAFUA\nFQBkYXk2NjYyK1IWAAD6FwAAAAAoAPUBAAAFAACAdQAAADIAAABIAAAAVgAVAGRheTY3MzEA\ndRoAAPoXAAAAACwA9QEAAAoAAIB5AAAAMgAAAEwAAABXABUAZGF5b2Z3ZWVrMWdopwEAACIE\nAAAAACwA9QEAAAoAAIB6AAAAMgAAAEwAAABYABUAZGF5b2Z3ZWVrMmdoygUAACIEAAAAACwA\n9QEAAAoAAIB9AAAAMgAAAEwAAABZABUAZGF5b2Z3ZWVrM2do6wkAACIEAAAAACwA9QEAAAoA\nAIB+AAAAMgAAAEwAAABaABUAZGF5b2Z3ZWVrNGdoDg4AACIEAAAAACwA9QEAAAoAAICAAAAA\nMgAAAEwAAABbABUAZGF5b2Z3ZWVrNWdoMRIAACIEAAAAACwA9QEAAAoAAICCAAAAMgAAAEwA\nAABcABUAZGF5b2Z3ZWVrNgAAUhYAACIEAAAAACwA9QEAAAoAAICDAAAAMgAAAEwAAABdABUA\nZGF5b2Z3ZWVrN2dodRoAACIEAAAAACwA9QEAAAkAAICEAAAAMgAAADQAAABeABUAYmFySGVp\nZ2h0AAAAjiMAAAAAAAAAADAA9QEAAA8AAICFAAAAMgAAAEAAAABfABUAcHJldk1vbnRoQnV0\ndG9ugFMWAADUAAAAAAAwAPUBAAAPAACAhgAAADIAAABAAAAAYAAVAG5leHRNb250aEJ1dHRv\nbh51GgAA1AAAAAAAcAD1CQAACgAAgIoAAAAyAAAANAAAAGQAFQA+AACAZGF0ZXRpbWViZ3V0\nAAAAAEkbAABJbnNlcnQgdG9kYXkncyBkYXRlLiBIaW50OiByaWdodCBjbGljayB0byBpbnNl\ncnQgZGF0ZSAmJiB0aW1lLgAAAAAsAPUBAAAKAACAhwAAADIAAABEAAAAYQAVAHRpbWVCdXR0\nb25naKcBAAAdHAAAAAAoAPUBAAAHAACAiAAAADIAAABAAAAAAAAA"
    }, 
    {
      "CODE_GRUP": "Forms", 
      "CODE_SNIPPET": "clsCalendarTime", 
      "clsCalendarTime.cls": "'\n''========================================================================================\n' Class:           clsModernStyle\n' Author:          VBATools\n' Version:         1.0.1\n' Creation Date:   18.11.2025 15:28\n' Update Date:     18.11.2025 15:28\n'========================================================================================\nPublic Enum enIconTime\n    icAddTo = 60616\n    icEmojiTabFavorites = 60762\n    icHistory = 59420\n    icRecent = 59427\n    icSetHistoryStatus = 63288\n    icSetHistoryStatus2 = 63289\n    icStopwatch = 59670\nEnd Enum\n\nPrivate WithEvents mTextBox As MSForms.TextBox\nPrivate WithEvents mLbArrowUpHours As MSForms.Label\nPrivate WithEvents mLbArrowDownHours As MSForms.Label\nPrivate WithEvents mLbArrowUpMinuts As MSForms.Label\nPrivate WithEvents mLbArrowDownMinuts As MSForms.Label\nPrivate WithEvents mLbBtn As MSForms.Label\nPrivate WithEvents mParent As MSForms.UserForm\n\nPrivate mMainPanel  As MSForms.Frame\nPrivate mLbMainColon As MSForms.Label\nPrivate mLbHours    As MSForms.Label\nPrivate mLbMinuts   As MSForms.Label\nPrivate mRightBtn   As Boolean\n\nPrivate Const SIZE_LABEL As Byte = 12\nPrivate Const SIZE_WIDTH As Byte = 45\n\n' Property: Version\n' Purpose: Gets version information about the class\nPublic Property Get Version() As String\n    Version = \"Version: 1.0.1\" & vbNewLine & _\n            \"Author: VBATools\" & vbNewLine & _\n            \"License: Apache\" & vbNewLine & _\n            \"Date of creation: 18.11.2025 15:28\" & vbNewLine & _\n            \"Date of update: 18.11.2025 15:28\"\nEnd Property\n\nPublic Property Get ForeColorArrowDownMinuts() As XlRgbColor\n    ForeColorArrowDownMinuts = mLbArrowDownMinuts.ForeColor\nEnd Property\n\nPublic Property Let ForeColorArrowDownMinuts(ByVal ValueColor As XlRgbColor)\n    mLbArrowDownMinuts.ForeColor = ValueColor\nEnd Property\n\nPublic Property Get ForeColorArrowUpMinuts() As XlRgbColor\n    ForeColorArrowUpMinuts = mLbArrowUpMinuts.ForeColor\nEnd Property\n\nPublic Property Let ForeColorArrowUpMinuts(ByVal ValueColor As XlRgbColor)\n    mLbArrowUpMinuts.ForeColor = ValueColor\nEnd Property\n\nPublic Property Get ForeColorArrowDownHours() As XlRgbColor\n    ForeColorArrowDownHours = mLbArrowDownHours.ForeColor\nEnd Property\n\nPublic Property Let ForeColorArrowDownHours(ByVal ValueColor As XlRgbColor)\n    mLbArrowDownHours.ForeColor = ValueColor\nEnd Property\n\nPublic Property Get ForeColorArrowUpHours() As XlRgbColor\n    ForeColorArrowUpHours = mLbArrowUpHours.ForeColor\nEnd Property\n\nPublic Property Let ForeColorArrowUpHours(ByVal ValueColor As XlRgbColor)\n    mLbArrowUpHours.ForeColor = ValueColor\nEnd Property\n\nPublic Property Get ForeColorColon() As XlRgbColor\n    ForeColorColon = mLbMainColon.ForeColor\nEnd Property\n\nPublic Property Let ForeColorColon(ByVal ValueColor As XlRgbColor)\n    mLbMainColon.ForeColor = ValueColor\nEnd Property\n\nPublic Property Get ForeColorMinuts() As XlRgbColor\n    ForeColorMinuts = mLbMinuts.ForeColor\nEnd Property\n\nPublic Property Let ForeColorMinuts(ByVal ValueColor As XlRgbColor)\n    mLbMinuts.ForeColor = ValueColor\nEnd Property\n\nPublic Property Get ForeColorHours() As XlRgbColor\n    ForeColorHours = mLbHours.ForeColor\nEnd Property\n\nPublic Property Let ForeColorHours(ByVal ValueColor As XlRgbColor)\n    mLbHours.ForeColor = ValueColor\nEnd Property\n\nPublic Property Get ForeColorBtn() As XlRgbColor\n    ForeColorBtn = mLbBtn.ForeColor\nEnd Property\n\nPublic Property Let ForeColorBtn(ByVal Color As XlRgbColor)\n    mLbBtn.ForeColor = Color\nEnd Property\n\nPublic Property Get ChoseDate() As Date\n    If IsDate(mTextBox.Value) Then\n        ChoseDate = VBA.CDate(mTextBox.Value)\n    End If\nEnd Property\n\nPublic Property Let ChoseDate(ByVal dtDate As Date)\n    If IsDate(dtDate) Then\n        mTextBox.Value = dtDate\n    End If\nEnd Property\n\nPublic Property Get IconCode() As Long\n    IconCode = VBA.Asc(mLbBtn.Caption)\nEnd Property\n\nPublic Property Let IconCode(ByVal IconCode As Long)\n    mLbBtn.Caption = VBA.ChrW$(IconCode)\nEnd Property\n\nPublic Property Get VisibleBtn() As Boolean\n    VisibleBtn = mLbBtn.Visible\nEnd Property\n\nPublic Property Let VisibleBtn(ByVal Value As Boolean)\n    mLbBtn.Visible = Value\nEnd Property\n\nPublic Property Get RightBtn() As Boolean\n    RightBtn = mRightBtn\nEnd Property\n\nPublic Property Let RightBtn(ByVal RightBtn As Boolean)\n    mRightBtn = RightBtn\n    If RightBtn Then\n        mLbBtn.Left = mTextBox.Left + mTextBox.Width\n    Else\n        mLbBtn.Left = mTextBox.Left - mLbBtn.Width\n    End If\nEnd Property\n\nPublic Sub addTimePicker(ByRef TextBox As MSForms.TextBox, _\n        Optional SetTime As Date = 0, _\n        Optional ForeColorBtn As XlRgbColor = rgbBlack, _\n        Optional RightBtn As Boolean = True, _\n        Optional VisibleBtn As Boolean = True, _\n        Optional IconCode As enIconTime = icStopwatch, _\n        Optional ForeColorHours As XlRgbColor = rgbBlack, _\n        Optional ForeColorMinuts As XlRgbColor = rgbBlack, _\n        Optional ForeColorColon As XlRgbColor = rgbBlack, _\n        Optional ForeColorArrowUpHours As XlRgbColor = rgbBlack, _\n        Optional ForeColorArrowDownHours As XlRgbColor = rgbBlack, _\n        Optional ForeColorArrowUpMinuts As XlRgbColor = rgbBlack, _\n        Optional ForeColorArrowDownMinuts As XlRgbColor = rgbBlack)\n\n    Set mTextBox = TextBox\n    Set mParent = mTextBox.Parent\n    With mTextBox\n        Set mMainPanel = mParent.Controls.Add(\"Forms.frame.1\", .Name & \"_lb_main\", True)\n        Set mLbBtn = mParent.Controls.Add(\"Forms.label.1\", .Name & \"_lb_btn\", True)\n    End With\n\n    If SetTime = 0 Then SetTime = VBA.Time()\n    mTextBox.Value = VBA.Format(SetTime, \"hh:mm\")\n    mRightBtn = RightBtn\n\n    With mMainPanel\n        Set mLbMainColon = .Controls.Add(\"Forms.label.1\", .Name & \"_lb_colon\", True)\n        Set mLbHours = .Controls.Add(\"Forms.label.1\", .Name & \"_lb_hour\", True)\n        Set mLbMinuts = .Controls.Add(\"Forms.label.1\", .Name & \"_lb_minute\", True)\n        Set mLbArrowUpHours = .Controls.Add(\"Forms.label.1\", .Name & \"_lb_arrow_up_hour\", True)\n        Set mLbArrowDownHours = .Controls.Add(\"Forms.label.1\", .Name & \"_lb_arrow_down_hour\", True)\n        Set mLbArrowUpMinuts = .Controls.Add(\"Forms.label.1\", .Name & \"_lb_arrow_up_minute\", True)\n        Set mLbArrowDownMinuts = .Controls.Add(\"Forms.label.1\", .Name & \"_lb_arrow_down_minute\", True)\n\n        If mTextBox.Width < SIZE_WIDTH Then\n            .Width = SIZE_WIDTH\n        Else\n            .Width = mTextBox.Width\n        End If\n        .Height = 40\n        If mTextBox.Top + mTextBox.Height + .Height > mParent.InsideHeight Then\n            .Top = mTextBox.Top - .Height - 2\n        Else\n            .Top = mTextBox.Top + mTextBox.Height + 2\n        End If\n        .Left = mTextBox.Left\n    End With\n\n    With mLbMainColon\n        .Width = SIZE_LABEL\n        .Height = SIZE_LABEL\n        .Caption = \":\"\n        .TextAlign = fmTextAlignCenter\n        .BackStyle = fmBackStyleTransparent\n        .Font.Bold = True\n        .Top = mMainPanel.Height / 2 - .Height / 2\n        .Left = mMainPanel.Width / 2 - .Width / 2\n        .ForeColor = ForeColorColon\n    End With\n\n    With mLbHours\n        .Width = SIZE_LABEL\n        .Height = SIZE_LABEL\n        .Caption = VBA.Format$(VBA.hour(SetTime), \"00\")\n        .TextAlign = fmTextAlignCenter\n        .BackStyle = fmBackStyleTransparent\n        .Font.Bold = True\n        .Top = mLbMainColon.Top\n        .Left = mLbMainColon.Left - mLbMainColon.Width\n        .ForeColor = ForeColorHours\n        .ZOrder 0\n    End With\n\n    With mLbMinuts\n        .Width = SIZE_LABEL\n        .Height = SIZE_LABEL\n        .Caption = VBA.Format$(VBA.Minute(SetTime), \"00\")\n        .TextAlign = fmTextAlignCenter\n        .BackStyle = fmBackStyleTransparent\n        .Font.Bold = True\n        .Top = mLbMainColon.Top\n        .Left = mLbMainColon.Left + mLbMainColon.Width\n        .ForeColor = ForeColorMinuts\n        .ZOrder 0\n    End With\n\n    With mLbBtn\n        .Height = mTextBox.Height\n        .Width = .Height\n        .Font.Size = .Height * 0.65\n        .Font.Name = \"Segoe MDL2 Assets\"\n        .Caption = VBA.ChrW$(IconCode)\n        .TextAlign = fmTextAlignCenter\n        .BackStyle = fmBackStyleTransparent\n        .Font.Bold = True\n        .ForeColor = ForeColorBtn\n        .Top = mTextBox.Top + 2\n        If RightBtn Then\n            .Left = mTextBox.Left + mTextBox.Width\n        Else\n            .Left = mTextBox.Left - .Width\n        End If\n        .ZOrder 0\n        .Visible = VisibleBtn\n    End With\n\n    Call addArrowLabel(mLbArrowUpHours, mLbHours, 59150, -1, ForeColorArrowUpHours)\n    Call addArrowLabel(mLbArrowDownHours, mLbHours, 59149, 1, ForeColorArrowDownHours)\n    Call addArrowLabel(mLbArrowUpMinuts, mLbMinuts, 59150, -1, ForeColorArrowUpMinuts)\n    Call addArrowLabel(mLbArrowDownMinuts, mLbMinuts, 59149, 1, ForeColorArrowDownMinuts)\n\n    mMainPanel.Visible = False\nEnd Sub\n\nPrivate Sub addArrowLabel(ByRef lbArrow As MSForms.Label, ByRef lbParent As MSForms.Label, ByVal IconCode As Long, ByVal iUp As Integer, ByVal ForeColor As Long)\n    With lbArrow\n        .Width = SIZE_LABEL\n        .Height = SIZE_LABEL\n        .TextAlign = fmTextAlignCenter\n        .BackStyle = fmBackStyleTransparent\n        .Font.Bold = True\n        .Font.Name = \"Segoe MDL2 Assets\"\n        .Font.Size = 10\n        .Caption = VBA.ChrW$(IconCode)\n        .Top = lbParent.Top + lbParent.Height * iUp\n        .Left = lbParent.Left\n        .ForeColor = ForeColor\n    End With\nEnd Sub\n\nPrivate Sub mTextBox_DblClick(ByVal Cancel As MSForms.ReturnBoolean)\n    Cancel = True\n    Call SetValueTextBox\nEnd Sub\n\nPrivate Sub mLbBtn_Click()\n    Call SetValueTextBox\nEnd Sub\n\nPrivate Sub SetValueTextBox()\n    mMainPanel.Visible = Not mMainPanel.Visible\n    If mMainPanel.Visible Then\n        If mTextBox.Value = vbNullString Then\n            mLbHours.Caption = VBA.Format$(VBA.hour(VBA.Time()), \"00\")\n            mLbMinuts.Caption = VBA.Format$(VBA.Minute(VBA.Time()), \"00\")\n        End If\n        mTextBox.Value = mLbHours.Caption & \":\" & mLbMinuts.Caption\n    End If\nEnd Sub\n\nPrivate Sub mParent_Click()\n    mMainPanel.Visible = False\nEnd Sub\n\nPrivate Sub mLbArrowUpHours_Click()\n    Call setTim(1, True)\nEnd Sub\n\nPrivate Sub mLbArrowDownHours_Click()\n    Call setTim(-1, True)\nEnd Sub\n\nPrivate Sub mLbArrowUpMinuts_Click()\n    Call setTim(1, False)\nEnd Sub\n\nPrivate Sub mLbArrowDownMinuts_Click()\n    Call setTim(-1, False)\nEnd Sub\n\nPrivate Sub setTim(ByVal iUp As Integer, isHour As Boolean)\n    Dim iHour       As Integer\n    Dim iMinute     As Integer\n\n    If isHour Then\n        iHour = VBA.CInt(mLbHours.Caption) + iUp\n        iMinute = VBA.CInt(mLbMinuts.Caption)\n        Select Case iHour\n            Case Is < 0\n                iHour = 23\n            Case Is > 23\n                iHour = 0\n            Case 0 To 23\n        End Select\n    Else\n        iHour = VBA.CInt(mLbHours.Caption)\n        iMinute = VBA.CInt(mLbMinuts.Caption) + iUp\n        Select Case iMinute\n            Case Is < 0\n                iMinute = 59\n                iHour = iHour + iUp\n            Case Is > 59\n                iMinute = 0\n                iHour = iHour + iUp\n            Case 0 To 59\n        End Select\n    End If\n    mLbHours.Caption = VBA.Format$(iHour, \"00\")\n    mLbMinuts.Caption = VBA.Format$(iMinute, \"00\")\n    mTextBox.Value = mLbHours.Caption & \":\" & mLbMinuts.Caption\nEnd Sub", 
      "CODE": "    Dim clTime          As clsCalendarTime\r\n    Set clTime = New clsCalendarTime\r\n    Call clTime.addTimePicker(TextBox1)", 
      "DISCRIPTION": ""
    }, 
    {
      "CODE_GRUP": "Forms", 
      "CODE_SNIPPET": "clsComboBox", 
      "clsComboBox.cls": "''* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\n'* Module     : clsComboBox - Eiio?ie ComboBox n iii?anoaaiiui auai?ii cia?aiee a ListBox\n'* Created    : 25-07-2025 09:38\n'* Author     : VBATools\n'* Contacts   : https://vk.com/vbatools\n'* Copyright  : VBATools.ru\n'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\n'*\n'* DESCRIPTION:   Eiio?ie ComboBox n iii?anoaaiiui auai?ii cia?aiee a ListBox\n'*\n'* PROPERTY:\n'*  Get/Let SortTextBox\n'*  Get     GetArrayIndexSelected\n'*  Get     GetArrayIndexUnSelected\n'*  Get/Let Delimetr\n'*  Get/Let BoundColumn\n'*  Get/Let Text\n'*  Get/Let ColumnCount\n'*  Get/Let List\n'*  Get     Value\n'*  Get     SelectedCount\n'*  Get     ListSelectedItems\n'*  Get/Let Visible\n'*      Let ListSelectedAll\n'*\n'* PROCEDURES PUBLIC:\n'*  Initialize\n'*  ReversSelected - revers selected item in listbox\n'*  RemoveSelected - delete items selected in listbox\n'*  RemoveUnSelected - delete items un selected in listbox\n'*\n'* PROCEDURES PRIVATE:\n'*  addArrayConst - add un selected list 0,1,2,3...\n'*  btnTextBox_Click\n'*  frmBtnOk_Click\n'*  frmBtnCancel_Click\n'*  frmList_Change\n'*  showHidenFrame - hiden or show listbox\n'*  updatTextInTextBox - add string for textbox with delimetr\n'*  selectItemsList - update list's: mListSelectedItems and mValueBoundColumn\n'*  lokedControls - locked all controls main form when open listbox\n'*\n'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\n\nPrivate WithEvents btnTextBox As MSForms.CommandButton\nPrivate WithEvents frmBtnOk As MSForms.CommandButton\nPrivate WithEvents frmBtnCancel As MSForms.CommandButton\nPrivate WithEvents frmList As MSForms.ListBox\n\nPrivate txtTextBox  As MSForms.textBox\nPrivate frmBox      As MSForms.Frame\nPrivate oParent     As Object\n\nPrivate mDelimetr   As String\nPrivate mListSelectedItems As Variant\nPrivate mValueBoundColumn As Variant\nPrivate mBoundColumn As Long\nPrivate mSortText   As Byte\n'1 - Up Sort\n'2 - Down Sort\n\nPrivate mbChange    As Boolean\nPrivate mBuferText  As String\n'iiaee??eou ?eaeeioaeo mscorlib.dll eee caiaieou  ArrayList ia CreateObject(\"System.Collections.ArrayList\")\nPrivate arrArrayListSelected As ArrayList\nPrivate arrArrayListUnSelected As ArrayList\nPrivate arrArrayListBufer As ArrayList\n\nPrivate Const FRM_WIDTH As Integer = 186\nPrivate Const BTN_WIDTH As Integer = 24\n\nPrivate Sub Class_Terminate()\n    Set btnTextBox = Nothing\n    Set frmBtnOk = Nothing\n    Set frmBtnCancel = Nothing\n    Set frmList = Nothing\n\n    Set txtTextBox = Nothing\n    Set frmBox = Nothing\n    Set oParent = Nothing\n\n    mDelimetr = Empty\n    mListSelectedItems = Empty\n    mValueBoundColumn = Empty\n    mBoundColumn = Empty\n    mSortText = Empty\n\n    mbChange = Empty\n\n    Set arrArrayListSelected = Nothing\n    Set arrArrayListUnSelected = Nothing\n    Set arrArrayListBufer = Nothing\nEnd Sub\n\n\nPublic Sub ReversSelected()\n    Set arrArrayListBufer = arrArrayListSelected.Clone\n    Set arrArrayListSelected = arrArrayListUnSelected.Clone\n    Set arrArrayListUnSelected = arrArrayListBufer.Clone\n    arrArrayListBufer.Clear\n    frmList.List = frmList.List\n    Call updatTextInTextBox\n    Call selectItemsList\nEnd Sub\n\nPublic Property Get SortTextBox() As Byte\n    SortTextBox = mSortText\nEnd Property\n\nPublic Property Let SortTextBox(ByVal bySort As Byte)\n    mSortText = bySort\n    With arrArrayListSelected\n        Select Case mSortText\n            Case 1\n                Call .Sort\n                arrArrayListUnSelected.Sort\n            Case 2\n                Call .Sort\n                Call .Reverse\n                arrArrayListUnSelected.Sort\n                arrArrayListUnSelected.Reverse\n                arrArrayListBufer.Reverse\n        End Select\n    End With\nEnd Property\n\nPublic Property Get GetArrayIndexSelected() As Variant\n    GetArrayIndexSelected = arrArrayListSelected.ToArray\nEnd Property\n\nPublic Property Get GetArrayIndexUnSelected() As Variant\n    GetArrayIndexUnSelected = arrArrayListUnSelected.ToArray\nEnd Property\n\nPublic Property Get Delimetr() As String\n    Delimetr = mDelimetr\nEnd Property\n\nPublic Property Let Delimetr(ByVal Delimetr As String)\n    mDelimetr = Delimetr\nEnd Property\n\nPublic Property Let BoundColumn(ByVal Column As Long)\n    If Column < 1 Then Call Err.Raise(Number:=vbObjectError + 100, Description:=\"BoundColumn must be greater than zero\")\n    frmList.BoundColumn = Column\n    mBoundColumn = Column\nEnd Property\n\nPublic Property Get BoundColumn() As Long\n    If mBoundColumn = 0 Then mBoundColumn = frmList.BoundColumn\n    BoundColumn = mBoundColumn\nEnd Property\n\nPublic Property Let Text(ByVal sText As String)\n    Dim arrList     As Variant\n    Dim iCountList  As Long\n\n    txtTextBox.Text = sText\n    arrArrayListUnSelected.Clear\n    arrArrayListSelected.Clear\n    Me.List = Me.List\n    arrList = Me.List\n    iCountList = UBound(arrList, 1)\n\n    If iCountList < 0 Or sText = vbNullString Then Exit Property\n    Call addArrayConst(arrArrayListUnSelected, iCountList)\n\n    Dim i           As Long\n    Dim j           As Long\n    Dim bFlag       As Boolean\n    Dim arr         As Variant\n    \n    arr = VBA.Split(sText, mDelimetr)\n    For j = 0 To UBound(arr)\n        For i = 0 To iCountList\n            If arr(j) = VBA.CStr(arrList(i, 0)) Then\n                Call arrArrayListUnSelected.Remove(i)\n                Call arrArrayListSelected.Add(i)\n                bFlag = True\n                Exit For\n            End If\n        Next i\n    Next j\n\n    If bFlag Then\n        Call selectItemsList\n        Call updatTextInTextBox\n    End If\nEnd Property\n\nPublic Property Get Text() As String\n    Text = txtTextBox.Text\nEnd Property\n\nPublic Property Let ColumnCount(ByVal iCount As Byte)\n    frmList.ColumnCount = iCount\nEnd Property\n\nPublic Property Get ColumnCount() As Byte\n    ColumnCount = frmList.ColumnCount\nEnd Property\n\nPublic Property Get List() As Variant\n    List = frmList.List\nEnd Property\n\nPublic Property Let List(ByVal arrList As Variant)\n    frmList.List = arrList\n    Call selectItemsList\nEnd Property\n\nPublic Property Get Value() As Variant\n    Call selectItemsList\n    Value = mValueBoundColumn\nEnd Property\n\nPublic Property Get SelectedCount() As Long\n    SelectedCount = arrArrayListSelected.Count\nEnd Property\n\nPublic Property Get ListSelectedItems() As Variant\n    Call selectItemsList\n    ListSelectedItems = mListSelectedItems\nEnd Property\n\nPublic Property Let ListSelectedItems(ByVal ListSelectedItems As Variant)\n    mListSelectedItems = ListSelectedItems\n    txtTextBox.Text = VBA.Join(ListSelectedItems, mDelimetr)\n    Call selectItemsList\nEnd Property\n\nPublic Property Let Visible(ByVal bVisible As Boolean)\n    frmBox.Visible = bVisible\nEnd Property\n\nPublic Property Get Visible() As Boolean\n    Visible = frmBox.Visible\nEnd Property\n\nPublic Property Let ListSelectedAll(ByVal bSelected As Boolean)\n    Application.ScreenUpdating = True\n    Dim j           As Long\n    Dim jCount      As Long\n    Dim sRes        As String\n    With frmList\n        jCount = .ListCount - 1\n        Call addArrayConst(arrArrayListBufer, jCount)\n        For j = 0 To jCount\n            mbChange = True\n            .Selected(j) = bSelected\n            mbChange = False\n            If bSelected Then\n                If sRes <> vbNullString Then sRes = sRes & mDelimetr\n                sRes = sRes & .List(arrArrayListBufer(j), 0)\n                sRes = putTextToBufer(sRes, j, jCount)\n            End If\n        Next j\n    End With\n    If bSelected Then\n        txtTextBox.Text = sRes\n        arrArrayListUnSelected.Clear\n        Set arrArrayListSelected = arrArrayListBufer.Clone\n    Else\n        txtTextBox.Text = vbNullString\n        mListSelectedItems = Empty\n        mValueBoundColumn = Empty\n        arrArrayListSelected.Clear\n        Set arrArrayListUnSelected = arrArrayListBufer.Clone\n    End If\n    mbChange = False\n    mBuferText = vbNullString\n    Application.ScreenUpdating = True\n    arrArrayListBufer.Clear\nEnd Property\n\n'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\n'* Sub        : Initialize - eieoeeecaoey eeanna\n'* Created    : 25-07-2025 09:57\n'* Author     : VBATools\n'* Contacts   : https://vk.com/vbatools\n'* Copyright  : VBATools.ru\n'* Argument(s):                         Description\n'*\n'* ByRef txtBox As MSForms.textBox  : ?iaeoaeuneee eiio?ie\n'* ByVal arrList As Variant         : nienie cia?aiee\n'* Optional sDelimetr As String     : ?acaaeeoaeu cia?aiee a oaeno aiena\n'* Optional SortTextBox As Byte     : iai?aaeaiea ni?oe?iaee cia?aiee a oaeno aiena\n'*                                  1 - aaa?o\n'*                                  2 - aiec\n'*                                  a?oaia - aac ni?oe?iaee\n'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\nPublic Sub Initialize(ByRef txtBox As MSForms.textBox, Optional arrList As Variant = Empty, Optional sDelimetr As String = \", \", Optional SortTextBox As Byte = 1)\n    Dim txtName     As String\n\n    txtName = txtBox.Name\n    Set oParent = txtBox.Parent\n    Set txtTextBox = txtBox\n    Set btnTextBox = oParent.Controls.Add(\"Forms.CommandButton.1\", \"btnTextBox\" & \"_\" & txtName, True)\n    mDelimetr = sDelimetr\n    mSortText = SortTextBox\n\n    With btnTextBox\n        .Top = txtTextBox.Top\n        .Height = txtTextBox.Height\n        .Left = txtTextBox.Left + txtTextBox.Width - BTN_WIDTH\n        .Width = BTN_WIDTH\n        .Font.Name = \"Wingdings 3\"\n        .Caption = \"q\"\n        .TabIndex = txtTextBox.TabIndex + 1\n    End With\n\n    Set frmBox = oParent.Controls.Add(\"Forms.Frame.1\", \"frmBox\" & \"_\" & txtName, False)\n    With frmBox\n        If oParent.InsideHeight - txtTextBox.Top - txtTextBox.Height > frmBox.Height Then\n            .Top = txtTextBox.Top + txtTextBox.Height\n        Else\n            .Top = txtTextBox.Top - frmBox.Height\n        End If\n        .Width = txtTextBox.Width\n        .Left = txtTextBox.Left\n        If .Width < FRM_WIDTH Then\n            If .Left + .Width > FRM_WIDTH Then .Left = .Left - (FRM_WIDTH - .Width)\n            .Width = FRM_WIDTH\n        End If\n        .Font.Size = txtTextBox.Font.Size\n        .Font.Name = txtTextBox.Font.Name\n        .Font.Bold = txtTextBox.Font.Bold\n        .Font.Italic = txtTextBox.Font.Italic\n        Call .ZOrder(1)\n    End With\n\n    Set frmList = frmBox.Controls.Add(\"Forms.ListBox.1\", \"frmList\" & \"_\" & txtName, True)\n    With frmList\n        .Width = frmBox.Width\n        .Top = -1\n        .Left = -1\n        .Height = frmBox.Height - BTN_WIDTH\n        .BorderStyle = txtTextBox.BorderStyle\n        .MultiSelect = fmMultiSelectMulti\n        .ListStyle = fmListStyleOption\n    End With\n    Set frmBtnOk = frmBox.Controls.Add(\"Forms.CommandButton.1\", \"frmBtnOk\" & \"_\" & txtName, True)\n    With frmBtnOk\n        .Top = frmList.Height + 1\n        .Left = 5\n        .Height = BTN_WIDTH - 1\n        .Caption = \"OK\"\n    End With\n\n    Set frmBtnCancel = frmBox.Controls.Add(\"Forms.CommandButton.1\", \"frmBtnCancel\" & \"_\" & txtName, True)\n    With frmBtnCancel\n        .Top = frmList.Height + 1\n        .Left = frmList.Width - .Width - 10\n        .Height = BTN_WIDTH - 1\n        .Caption = \"IOIAIA\"\n    End With\n\n    txtTextBox.Width = txtTextBox.Width - BTN_WIDTH\n    Set arrArrayListUnSelected = New ArrayList\n    Set arrArrayListSelected = New ArrayList\n    Set arrArrayListBufer = New ArrayList\n\n    If Not IsEmpty(arrList) Then\n        frmList.List = arrList\n        Call addArrayConst(arrArrayListUnSelected, UBound(arrList) - 1)\n    End If\n    Me.SortTextBox = mSortText\nEnd Sub\n\nPrivate Sub btnTextBox_Click()\n    Call showHidenFrame\n    Call updatTextInTextBox\n    Set arrArrayListBufer = arrArrayListSelected.Clone\nEnd Sub\n\nPrivate Sub frmBtnOk_Click()\n    Call showHidenFrame\n    Set arrArrayListSelected = arrArrayListBufer.Clone\n    Dim i           As Long\n    Call addArrayConst(arrArrayListUnSelected, frmList.ListCount - 1)\n    With arrArrayListUnSelected\n        For i = arrArrayListBufer.Count - 1 To 0 Step -1\n            If .Contains(arrArrayListBufer(i)) Then Call .Remove(arrArrayListBufer(i))\n        Next i\n    End With\n    Call updatTextInTextBox\n    arrArrayListBufer.Clear\n    Me.SortTextBox = mSortText\nEnd Sub\n\nPrivate Sub frmBtnCancel_Click()\n    Call showHidenFrame\n    Call updatTextInTextBox\n    arrArrayListBufer.Clear\nEnd Sub\n\nPrivate Sub frmList_Change()\n    If mbChange Then Exit Sub\n    Dim index       As Long\n    index = frmList.ListIndex\n    If index < 0 Then Exit Sub\n    With arrArrayListBufer\n        If frmList.Selected(index) Then\n            If Not .Contains(index) Then Call .Add(index)\n        Else\n            If .Contains(index) Then Call .Remove(index)\n        End If\n    End With\nEnd Sub\n\nPrivate Sub showHidenFrame()\n    Application.ScreenUpdating = False\n    With frmBox\n        '.Visible = True\n        .ZOrder 1\n        If Not .Visible Then .ZOrder 0\n        .Visible = Not .Visible\n        Call lokedControls(.Visible)\n    End With\n    Application.ScreenUpdating = True\nEnd Sub\n\nPrivate Sub updatTextInTextBox()\n    Dim sRes        As String\n    Dim j           As Long\n    Dim jCount      As Long\n\n    mbChange = True\n    Me.SortTextBox = mSortText\n    With frmList\n        jCount = arrArrayListSelected.Count - 1\n        For j = 0 To jCount\n            .Selected(arrArrayListSelected(j)) = True\n            If sRes <> vbNullString Then sRes = sRes & mDelimetr\n            sRes = sRes & .List(arrArrayListSelected(j), 0)\n            sRes = putTextToBufer(sRes, j, jCount)\n        Next j\n        txtTextBox.Text = sRes\n    End With\n    mbChange = False\n    mBuferText = vbNullString\nEnd Sub\n\nPrivate Sub selectItemsList()\n    Dim i           As Long\n    Dim iCount      As Long\n    Dim m           As Byte\n    Dim mCount      As Byte\n    Dim item        As Long\n\n    With arrArrayListSelected\n        iCount = .Count - 1\n        If iCount < 0 Then\n            mListSelectedItems = Empty\n            mValueBoundColumn = Empty\n            arrArrayListSelected.Clear\n            Call addArrayConst(arrArrayListUnSelected, frmList.ListCount - 1)\n            Exit Sub\n        End If\n        If frmList.ListIndex < 0 Then Exit Sub\n        mCount = frmList.ColumnCount - 1\n        ReDim mListSelectedItems(1 To iCount + 1, 1 To mCount + 1)\n        ReDim mValueBoundColumn(1 To iCount + 1, 1 To 1)\n\n        For i = 0 To iCount\n            item = arrArrayListSelected(i)\n            mValueBoundColumn(i + 1, 1) = frmList.List(item, mBoundColumn - 1)\n            For m = 0 To mCount\n                mListSelectedItems(i + 1, m + 1) = frmList.List(item, m)\n            Next m\n        Next i\n    End With\nEnd Sub\n\nPrivate Sub lokedControls(ByVal bLocked As Boolean)\n    Dim cnt         As MSForms.Control\n    For Each cnt In oParent.Controls\n        With cnt\n            If .Name <> txtTextBox.Name And Not .Name Like \"*_\" & txtTextBox.Name Then\n                Select Case TypeName(cnt)\n                    Case \"Label\", \"Frame\", \"Image\"\n                    Case Else\n                        .Locked = bLocked\n                End Select\n            End If\n        End With\n    Next cnt\nEnd Sub\n\n'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\n'* Sub        : RemoveSelected - oaaeeou aua?aiiua a eenoaiena\n'* Created    : 25-07-2025 10:00\n'* Author     : VBATools\n'* Contacts   : https://vk.com/vbatools\n'* Copyright  : VBATools.ru\n'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\nPublic Sub RemoveSelected()\n    Dim i           As Long\n    Dim iCount      As Long\n    With frmList\n        arrArrayListSelected.Sort\n        iCount = arrArrayListSelected.Count - 1\n        If iCount < 0 Then Exit Sub\n        For i = iCount To 0 Step -1\n            Call .RemoveItem(arrArrayListSelected(i))\n        Next i\n        txtTextBox.Text = vbNullString\n        arrArrayListSelected.Clear\n        Call addArrayConst(arrArrayListUnSelected, frmList.ListCount - 1)\n    End With\nEnd Sub\n\n'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\n'* Sub        : RemoveUnSelected - oaaeeou IA aua?aiiua a eenoaiena\n'* Created    : 25-07-2025 10:00\n'* Author     : VBATools\n'* Contacts   : https://vk.com/vbatools\n'* Copyright  : VBATools.ru\n'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\nPublic Sub RemoveUnSelected()\n    Call selectItemsList\n    txtTextBox.Text = vbNullString\n    arrArrayListSelected.Clear\n    If Not IsEmpty(mListSelectedItems) Then\n        frmList.List = mListSelectedItems\n        Call addArrayConst(arrArrayListUnSelected, frmList.ListCount - 1)\n    Else\n        frmList.Clear\n        arrArrayListUnSelected.Clear\n    End If\nEnd Sub\n\nPrivate Sub addArrayConst(ByRef addArray As ArrayList, ByRef iCount As Long)\n    Dim i           As Long\n    With addArray\n        .Clear\n        For i = 0 To iCount\n            Call .Add(i)\n        Next i\n    End With\n    Me.SortTextBox = mSortText\nEnd Sub\n\nPrivate Function putTextToBufer(ByRef sVal As String, ByRef itemNumber As LongPtr, ByRef iCount As LongPtr) As String\n    If VBA.Len(sVal) > 1000 Then\n        If mBuferText <> vbNullString Then mBuferText = mBuferText & mDelimetr\n        mBuferText = mBuferText & sVal\n        sVal = vbNullString\n    End If\n    If itemNumber = iCount Then\n        If mBuferText <> vbNullString Then mBuferText = mBuferText & mDelimetr\n        putTextToBufer = mBuferText & sVal\n    Else\n        putTextToBufer = sVal\n    End If\nEnd Function\n\n", 
      "CODE": "Dim cmb2                      As clsComboBox\r\nSet cmb = New clsComboBox\r\nCall cmb.Initialize(txtBox:=txtValue, arrList:=arr, sDelimetr:=\", \", SortTextBox:=1)", 
      "DISCRIPTION": "Класс, ComboBox Multi"
    }, 
    {
      "CODE_GRUP": "Forms", 
      "CODE_SNIPPET": "clsComboBoxForm", 
      "clsComboBoxForm.cls": "''* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\n'* Module     : clsComboBox - Eiio?ie ComboBox n iii?anoaaiiui auai?ii cia?aiee a ListBox\n'* Created    : 25-07-2025 09:38\n'* Author     : VBATools\n'* Contacts   : https://vk.com/vbatools\n'* Copyright  : VBATools.ru\n'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\n'*\n'* DESCRIPTION:   Eiio?ie ComboBox n iii?anoaaiiui auai?ii cia?aiee a ListBox\n'*\n'* PROPERTY:\n'*  Get/Let SortTextBox\n'*  Get     GetArrayIndexSelected\n'*  Get     GetArrayIndexUnSelected\n'*  Get/Let Delimetr\n'*  Get/Let BoundColumn\n'*  Get/Let Text\n'*  Get/Let ColumnCount\n'*  Get/Let List\n'*  Get     Value\n'*  Get     SelectedCount\n'*  Get     ListSelectedItems\n'*  Get/Let Visible\n'*      Let ListSelectedAll\n'*\n'* PROCEDURES PUBLIC:\n'*  Initialize\n'*  ReversSelected\n'*  RemoveSelected\n'*  RemoveUnSelected\n'*\n'* PROCEDURES PRIVATE:\n'*  addArrayConst - add un selected list 0,1,2,3...\n'*  btnTextBox_Click\n'*  frmList_Change\n'*  showHidenFrame - hiden or show listbox\n'*  updatTextInTextBox - add string for textbox with delimetr\n'*  selectItemsList - update list's: mListSelectedItems and mValueBoundColumn\n'*\n'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\n\nPrivate WithEvents btnTextBox As MSForms.CommandButton\nPrivate WithEvents frmList As MSForms.ListBox\n\nPrivate txtTextBox  As MSForms.textBox\nPrivate frmBox      As frmComboBox\n\nPrivate mDelimetr   As String\nPrivate mListSelectedItems As Variant\nPrivate mValueBoundColumn As Variant\nPrivate mBoundColumn As Long\nPrivate mSortText   As Byte\n'1 - Up Sort\n'2 - Down Sort\n\nPrivate mbChange    As Boolean\nPrivate mBuferText  As String\n'iiaee??eou ?eaeeioaeo mscorlib.dll eee caiaieou  ArrayList ia CreateObject(\"System.Collections.ArrayList\")\nPrivate arrArrayListSelected As ArrayList\nPrivate arrArrayListUnSelected As ArrayList\nPrivate arrArrayListBufer As ArrayList\n\nPrivate Const BTN_WIDTH As Integer = 24\n\nPrivate Sub Class_Terminate()\n    Set btnTextBox = Nothing\n\n    Set txtTextBox = Nothing\n    Set frmBox = Nothing\n\n    mDelimetr = Empty\n    mListSelectedItems = Empty\n    mValueBoundColumn = Empty\n    mBoundColumn = Empty\n    mSortText = Empty\n\n    mbChange = Empty\n\n    Set arrArrayListSelected = Nothing\n    Set arrArrayListUnSelected = Nothing\n    Set arrArrayListBufer = Nothing\nEnd Sub\n\nPublic Sub ReversSelected()\n    Set arrArrayListBufer = arrArrayListSelected.Clone\n    Set arrArrayListSelected = arrArrayListUnSelected.Clone\n    Set arrArrayListUnSelected = arrArrayListBufer.Clone\n    arrArrayListBufer.Clear\n    frmList.List = frmList.List\n    Call updatTextInTextBox\n    Call selectItemsList\nEnd Sub\n\nPublic Property Get SortTextBox() As Byte\n    SortTextBox = mSortText\nEnd Property\n\nPublic Property Let SortTextBox(ByVal bySort As Byte)\n    mSortText = bySort\n    With arrArrayListSelected\n        Select Case mSortText\n            Case 1\n                Call .Sort\n                arrArrayListUnSelected.Sort\n            Case 2\n                Call .Sort\n                Call .Reverse\n                arrArrayListUnSelected.Sort\n                arrArrayListUnSelected.Reverse\n        End Select\n    End With\nEnd Property\n\nPublic Property Get GetArrayIndexSelected() As Variant\n    GetArrayIndexSelected = arrArrayListSelected.ToArray\nEnd Property\n\nPublic Property Get GetArrayIndexUnSelected() As Variant\n    GetArrayIndexUnSelected = arrArrayListUnSelected.ToArray\nEnd Property\n\nPublic Property Get Delimetr() As String\n    Delimetr = mDelimetr\nEnd Property\n\nPublic Property Let Delimetr(ByVal Delimetr As String)\n    mDelimetr = Delimetr\nEnd Property\n\nPublic Property Let BoundColumn(ByVal Column As Long)\n    If Column < 1 Then Call Err.Raise(Number:=vbObjectError + 100, Description:=\"BoundColumn must be greater than zero\")\n    frmList.BoundColumn = Column\n    mBoundColumn = Column\nEnd Property\n\nPublic Property Get BoundColumn() As Long\n    If mBoundColumn = 0 Then mBoundColumn = frmList.BoundColumn\n    BoundColumn = mBoundColumn\nEnd Property\n\nPublic Property Let Text(ByVal sText As String)\n    Dim arrList     As Variant\n    Dim iCountList  As Long\n\n    txtTextBox.Text = sText\n    arrArrayListUnSelected.Clear\n    arrArrayListSelected.Clear\n    Me.List = Me.List\n    arrList = Me.List\n    iCountList = UBound(arrList, 1)\n\n    If iCountList < 0 Or sText = vbNullString Then Exit Property\n    Call addArrayConst(arrArrayListUnSelected, iCountList)\n\n    Dim i           As Long\n    Dim j           As Long\n    Dim bFlag       As Boolean\n    Dim arr         As Variant\n    \n    arr = VBA.Split(sText, mDelimetr)\n    For j = 0 To UBound(arr)\n        For i = 0 To iCountList\n            If arr(j) = VBA.CStr(arrList(i, 0)) Then\n                Call arrArrayListUnSelected.Remove(i)\n                Call arrArrayListSelected.Add(i)\n                bFlag = True\n                Exit For\n            End If\n        Next i\n    Next j\n\n    If bFlag Then\n        Call selectItemsList\n        Call updatTextInTextBox\n    End If\nEnd Property\n\nPublic Property Get Text() As String\n    Text = txtTextBox.Text\nEnd Property\n\nPublic Property Let ColumnCount(ByVal iCount As Byte)\n    frmList.ColumnCount = iCount\nEnd Property\n\nPublic Property Get ColumnCount() As Byte\n    ColumnCount = frmList.ColumnCount\nEnd Property\n\nPublic Property Get List() As Variant\n    List = frmList.List\nEnd Property\n\nPublic Property Let List(ByVal arrList As Variant)\n    frmList.List = arrList\n    Call selectItemsList\nEnd Property\n\nPublic Property Get Value() As Variant\n    Call selectItemsList\n    Value = mValueBoundColumn\nEnd Property\n\nPublic Property Get SelectedCount() As Long\n    SelectedCount = arrArrayListSelected.Count\nEnd Property\n\nPublic Property Get ListSelectedItems() As Variant\n    Call selectItemsList\n    ListSelectedItems = mListSelectedItems\nEnd Property\n\nPublic Property Let Visible(ByVal bVisible As Boolean)\n    If bVisible Then\n        frmBox.Show\n    Else\n        frmBox.Hide\n    End If\nEnd Property\n\nPublic Property Get Visible() As Boolean\n    Visible = frmBox.Visible\nEnd Property\n\nPublic Property Let ListSelectedAll(ByVal bSelected As Boolean)\n    Application.ScreenUpdating = True\n    Dim j           As Long\n    Dim jCount      As Long\n    Dim sRes        As String\n    With frmList\n        jCount = .ListCount - 1\n        For j = 0 To jCount\n            mbChange = True\n            .Selected(j) = bSelected\n            mbChange = False\n            If bSelected Then\n                If sRes <> vbNullString Then sRes = sRes & mDelimetr\n                sRes = sRes & .List(j, 0)\n                sRes = putTextToBufer(sRes, j, jCount)\n            End If\n        Next j\n    End With\n    If bSelected Then\n        txtTextBox.Text = sRes\n        arrArrayListUnSelected.Clear\n        Call addArrayConst(arrArrayListSelected, jCount)\n    Else\n        txtTextBox.Text = vbNullString\n        mListSelectedItems = Empty\n        mValueBoundColumn = Empty\n        arrArrayListSelected.Clear\n        Call addArrayConst(arrArrayListUnSelected, jCount)\n    End If\n    mbChange = False\n    mBuferText = vbNullString\n    Application.ScreenUpdating = False\nEnd Property\n\n'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\n'* Sub        : Initialize - eieoeeecaoey eeanna\n'* Created    : 25-07-2025 09:57\n'* Author     : VBATools\n'* Contacts   : https://vk.com/vbatools\n'* Copyright  : VBATools.ru\n'* Argument(s):                         Description\n'*\n'* ByRef txtBox As MSForms.textBox  : ?iaeoaeuneee eiio?ie\n'* ByVal arrList As Variant         : nienie cia?aiee\n'* Optional sDelimetr As String     : ?acaaeeoaeu cia?aiee a oaeno aiena\n'* Optional SortTextBox As Byte     : iai?aaeaiea ni?oe?iaee cia?aiee a oaeno aiena\n'*                                  1 - aaa?o\n'*                                  2 - aiec\n'*                                  a?oaia - aac ni?oe?iaee\n'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\nPublic Sub Initialize(ByRef txtBox As MSForms.textBox, Optional arrList As Variant = Empty, Optional sCaption As String = vbNullString, Optional sDelimetr As String = \", \", Optional SortTextBox As Byte = 1)\n    Dim oParent     As Object\n    Dim txtName     As String\n\n    mDelimetr = sDelimetr\n    mSortText = SortTextBox\n    txtName = txtBox.Name\n    Set oParent = txtBox.Parent\n    Set txtTextBox = txtBox\n\n    Set btnTextBox = oParent.Controls.Add(\"Forms.CommandButton.1\", \"btnTextBox\" & \"_\" & txtName, True)\n    Set frmBox = getForm()\n    frmBox.Caption = sCaption\n    Set frmList = frmBox.frmList\n\n    With btnTextBox\n        .Top = txtTextBox.Top\n        .Height = txtTextBox.Height\n        .Left = txtTextBox.Left + txtTextBox.Width - BTN_WIDTH\n        .Width = BTN_WIDTH\n        .Font.Name = \"Wingdings 3\"\n        .Caption = \"q\"\n        .TabIndex = txtTextBox.TabIndex + 1\n    End With\n\n    Set arrArrayListSelected = New ArrayList\n    Set arrArrayListUnSelected = New ArrayList\n    Set arrArrayListBufer = New ArrayList\n\n    If Not IsEmpty(arrList) Then\n        frmList.List = arrList\n        Call addArrayConst(arrArrayListUnSelected, UBound(arrList) - 1)\n    End If\n    Me.SortTextBox = mSortText\nEnd Sub\n\nPrivate Function getForm() As frmComboBox\n    If frmBox Is Nothing Then\n        Set getForm = New frmComboBox\n    Else\n        Set getForm = frmBox\n    End If\nEnd Function\n\nPrivate Sub btnTextBox_Click()\n    Set frmBox = getForm()\n    Set arrArrayListBufer = arrArrayListSelected.Clone\n    With frmBox\n        .Show\n        If .lbBtn = \"1\" Then\n            Set arrArrayListSelected = arrArrayListBufer.Clone\n            Dim i   As Long\n            Call addArrayConst(arrArrayListUnSelected, frmList.ListCount - 1)\n            With arrArrayListUnSelected\n                For i = arrArrayListBufer.Count - 1 To 0 Step -1\n                    If .Contains(arrArrayListBufer(i)) Then Call .Remove(arrArrayListBufer(i))\n                Next i\n            End With\n        End If\n    End With\n    Call updatTextInTextBox\n    arrArrayListBufer.Clear\n    Me.SortTextBox = mSortText\nEnd Sub\n\nPrivate Sub frmList_Change()\n    If mbChange Then Exit Sub\n    Dim index       As Long\n    index = frmList.ListIndex\n    If index < 0 Then Exit Sub\n    With arrArrayListBufer\n        If frmList.Selected(index) Then\n            If Not .Contains(index) Then Call .Add(index)\n        Else\n            If .Contains(index) Then Call .Remove(index)\n        End If\n    End With\nEnd Sub\n\nPrivate Sub updatTextInTextBox()\n    Dim sRes        As String\n    Dim j           As Long\n    Dim jCount      As Long\n\n    mbChange = True\n    Me.SortTextBox = mSortText\n    With frmList\n        jCount = arrArrayListSelected.Count - 1\n        For j = 0 To jCount\n            .Selected(arrArrayListSelected(j)) = True\n            If sRes <> vbNullString Then sRes = sRes & mDelimetr\n            sRes = sRes & .List(arrArrayListSelected(j), 0)\n            sRes = putTextToBufer(sRes, j, jCount)\n        Next j\n        txtTextBox.Text = sRes\n    End With\n    mbChange = False\n    mBuferText = vbNullString\nEnd Sub\nPrivate Sub selectItemsList()\n    Dim i           As Long\n    Dim iCount      As Long\n    Dim m           As Byte\n    Dim mCount      As Byte\n    Dim item        As Long\n\n    With arrArrayListSelected\n        iCount = .Count - 1\n        If iCount < 0 Then\n            mListSelectedItems = Empty\n            mValueBoundColumn = Empty\n            arrArrayListSelected.Clear\n            Call addArrayConst(arrArrayListUnSelected, frmList.ListCount - 1)\n            Exit Sub\n        End If\n        If frmList.ListIndex < 0 Then Exit Sub\n        mCount = frmList.ColumnCount - 1\n        ReDim mListSelectedItems(1 To iCount + 1, 1 To mCount + 1)\n        ReDim mValueBoundColumn(1 To iCount + 1, 1 To 1)\n\n        For i = 0 To iCount\n            item = arrArrayListSelected(i)\n            mValueBoundColumn(i + 1, 1) = frmList.List(item, mBoundColumn - 1)\n            For m = 0 To mCount\n                mListSelectedItems(i + 1, m + 1) = frmList.List(item, m)\n            Next m\n        Next i\n    End With\nEnd Sub\n\n'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\n'* Sub        : RemoveSelected - oaaeeou aua?aiiua a eenoaiena\n'* Created    : 25-07-2025 10:00\n'* Author     : VBATools\n'* Contacts   : https://vk.com/vbatools\n'* Copyright  : VBATools.ru\n'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\nPublic Sub RemoveSelected()\n    Dim i           As Long\n    Dim iCount      As Long\n    With frmList\n        arrArrayListSelected.Sort\n        iCount = arrArrayListSelected.Count - 1\n        If iCount < 0 Then Exit Sub\n        For i = iCount To 0 Step -1\n            Call .RemoveItem(arrArrayListSelected(i))\n        Next i\n        txtTextBox.Text = vbNullString\n        arrArrayListSelected.Clear\n        arrArrayListUnSelected.Clear\n        Call addArrayConst(arrArrayListUnSelected, frmList.ListCount - 1)\n    End With\nEnd Sub\n\n'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\n'* Sub        : RemoveUnSelected - oaaeeou IA aua?aiiua a eenoaiena\n'* Created    : 25-07-2025 10:00\n'* Author     : VBATools\n'* Contacts   : https://vk.com/vbatools\n'* Copyright  : VBATools.ru\n'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\nPublic Sub RemoveUnSelected()\n    Call selectItemsList\n    txtTextBox.Text = vbNullString\n    arrArrayListSelected.Clear\n    If Not IsEmpty(mListSelectedItems) Then\n        frmList.List = mListSelectedItems\n        Call addArrayConst(arrArrayListUnSelected, frmList.ListCount - 1)\n    Else\n        frmList.Clear\n        arrArrayListUnSelected.Clear\n    End If\nEnd Sub\n\nPrivate Sub addArrayConst(ByRef addArray As ArrayList, ByRef iCount As Long)\n    Dim i           As Long\n    With addArray\n        .Clear\n        For i = 0 To iCount\n            Call .Add(i)\n        Next i\n    End With\n    Me.SortTextBox = mSortText\nEnd Sub\n\nPrivate Function putTextToBufer(ByRef sVal As String, ByRef itemNumber As LongPtr, ByRef iCount As LongPtr) As String\n    If VBA.Len(sVal) > 1000 Then\n        If mBuferText <> vbNullString Then mBuferText = mBuferText & mDelimetr\n        mBuferText = mBuferText & sVal\n        sVal = vbNullString\n    End If\n    If itemNumber = iCount Then\n        If mBuferText <> vbNullString Then mBuferText = mBuferText & mDelimetr\n        putTextToBufer = mBuferText & sVal\n    Else\n        putTextToBufer = sVal\n    End If\nEnd Function\n\n", 
      "CODE": "Dim cmb                       As clsComboBoxForm\r\nSet cmb = New clsComboBoxForm\r\nCall cmb.Initialize(txtBox:=txtValue, arrList:=arr, sDelimetr:=\", \", SortTextBox:=1)", 
      "DISCRIPTION": "Класс, ComboBox Multi с модальным окном", 
      "frmComboBox.frm": "VERSION 5.00\n\nBegin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} frmComboBox \n\n   ClientHeight    =   4395\n\n   ClientLeft      =   120\n\n   ClientTop       =   465\n\n   ClientWidth     =   4785\n\n   OleObjectBlob   =   \"frmComboBox.frx\":0000\n\n   StartUpPosition =   1  'CenterOwner\n\nEnd\n\nAttribute VB_Name = \"frmComboBox\"\n\nAttribute VB_GlobalNameSpace = False\n\nAttribute VB_Creatable = False\n\nAttribute VB_PredeclaredId = True\n\nAttribute VB_Exposed = False\n\nOption Explicit\n\n\n\nPrivate Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)\n\n    If CloseMode = 0 Then Cancel = True\n\nEnd Sub\n\n\n\n\n\nPrivate Sub btnCancel_Click()\n\n    lbBtn.Caption = -1\n\n    Me.Hide\n\nEnd Sub\n\n\n\nPrivate Sub btnOk_Click()\n\n    lbBtn.Caption = 1\n\n    Me.Hide\n\nEnd Sub\n\n\n\nPrivate Sub UserForm_Initialize()\n\n    With Me\n\n        .StartUpPosition = 0\n\n        .Left = Application.Left + 0.5 * (Application.Width - .Width)\n\n        .Top = Application.Top + 0.5 * (Application.Height - .Height)\n\n    End With\n\nEnd Sub\n\n\n\n", 
      "frmComboBox.frx": "TEIIAAAMAAAAAAAAAAAAAKETAAB0EwAA0M8R4KGxGuEAAAAAAAAAAAAAAAAAAAAAPgADAP7/\nCQAGAAAAAAAAAAAAAAABAAAAAQAAAAAAAAAAEAAAAgAAAAEAAAD+////AAAAAAAAAAD/////\n////////////////////////////////////////////////////////////////////////\n////////////////////////////////////////////////////////////////////////\n////////////////////////////////////////////////////////////////////////\n////////////////////////////////////////////////////////////////////////\n////////////////////////////////////////////////////////////////////////\n////////////////////////////////////////////////////////////////////////\n////////////////////////////////////////////////////////////////////////\n///////////////////////////////////////////////////////////////////9////\n/v////7///8EAAAA/v//////////////////////////////////////////////////////\n////////////////////////////////////////////////////////////////////////\n////////////////////////////////////////////////////////////////////////\n////////////////////////////////////////////////////////////////////////\n////////////////////////////////////////////////////////////////////////\n////////////////////////////////////////////////////////////////////////\n////////////////////////////////////////////////////////////////////////\n////////////////////////////////////////////////////////////////////////\n////////////////////////////////////////////////////////////////////////\n/////////////////////////////1IAbwBvAHQAIABFAG4AdAByAHkAAAAAAAAAAAAAAAAA\nAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAWAAUA//////////8CAAAA8GkqxtwW\nzhGemACqAFdKTwAAAAAAAAAAAAAAAABETt8dAdwBAwAAAIACAAAAAAAAZgAAAAAAAAAAAAAA\nAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAQA\nAgD///////////////8AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA\n2gAAAAAAAABvAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA\nAAAAAAAAAAAAAAAAAAAAAAAABAACAQEAAAADAAAA/////wAAAAAAAAAAAAAAAAAAAAAAAAAA\nAAAAAAAAAAAAAAAAAAAAAAEAAADkAAAAAAAAAAEAQwBvAG0AcABPAGIAagAAAAAAAAAAAAAA\nAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAASAAIA////////////////\nAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACAAAAG4AAAAAAAAABQAAAAIA\nAAADAAAABAAAAP7///8GAAAABwAAAP7///8JAAAA/v//////////////////////////////\n////////////////////////////////////////////////////////////////////////\n////////////////////////////////////////////////////////////////////////\n////////////////////////////////////////////////////////////////////////\n////////////////////////////////////////////////////////////////////////\n////////////////////////////////////////////////////////////////////////\n////////////////////////////////////////////////////////////////////////\n////////////////////////////////////////////////////////////////////////\n////////////////////////////////////////////////////////////////////////\n//////////////////////////8ABCAACAwADAUAAAANAAAAAH0AAPggAABIHgAAAAAAAAAA\nAAAAAAQAAACsAAAAAIQBBQAAJADlAQAABQAAgAIAAAIUACgAAAACAACAT0sAAGcMAABPAwAA\nAAIYAHUAAAAGAACApQAAAMwCAwBUYWhvbWEAAAACHAAoAAAADAAAAB4EIgQcBBUEHQQQBGcM\nAABPAwAAAAIYAHUAAAAGAACApQAAAMwCAwBUYWhvbWEAAAACFAAoAAAAAgAAgC0xAAD2BAAA\nTwMAAAACGAA1AAAABgAAgKUAAADMAgAAVGFob21hmyMAAiAAcQEjhAAAAAAbAIAsAQMCAAEB\nAAAAAAAAEyEAAKIZAAAAAhgANQAAAAYAAIClAAAAzAIAAFRhaG9tYSthAAAAAAAAAAAAAAAA\nAAAAAAAAAAAAAAAAAAAAAAAANAAAAAEAEQBidG5Pa2GbI9QAAAB1GgAAAAAoAOUBAAAJAACA\nAwAAADwAAAACABEAYnRuQ2FuY2VsAAAA2BMAAHUaAAAAACgA9QEAAAUAAIAFAAAAMgAAADQA\nAAADABUAbGJCdG4AAACwJwAABBMAAAAAJADlAQAABwAAgAEAAABAAAAAAAAYAGZybUxpc3QA\nAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAEA/v8DCgAA\n//////BpKsbcFs4RnpgAqgBXSk8ZAAAATWljcm9zb2Z0IEZvcm1zIDIuMCBGb3JtABAAAABF\nbWJlZGRlZCBPYmplY3QADQAAAEZvcm1zLkZvcm0uMQD0ObJxAAAAAAAAAAAAAAAAAAAAAAAA\nAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA\nAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA\nAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA\nAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA\nAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA\nAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA\nAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA\nAAAAAAAAAAAAAAAAAAAAAAAAAAAA"
    }, 
    {
      "CODE_GRUP": "Forms", 
      "CODE_SNIPPET": "clsContextMenu", 
      "clsContextMenu.cls": "\nPrivate m_cbrContextMenu As CommandBar\nPrivate m_contextMenuName As String\n\nPrivate WithEvents m_ListBox As MSForms.ListBox\nPrivate WithEvents m_TextBox As MSForms.textBox\nPrivate WithEvents m_UserForm As MSForms.UserForm\n\nPrivate Sub m_ListBox_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)\n    If Button = 2 Then m_cbrContextMenu.ShowPopup\nEnd Sub\n\nPrivate Sub m_TextBox_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)\n    If Button = 2 Then m_cbrContextMenu.ShowPopup\nEnd Sub\n\nPrivate Sub m_UserForm_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)\n    If Button = 2 Then m_cbrContextMenu.ShowPopup\nEnd Sub\n\nPublic Property Get prContextMenuName() As String\n    prContextMenuName = m_contextMenuName\nEnd Property\n\nPublic Property Get prCountControls() As Integer\n    prCountControls = m_cbrContextMenu.Controls.Count\nEnd Property\n\nPublic Property Set prBoundControl(ByRef Control As Object)\n    Select Case TypeName(Control)\n        Case \"ListBox\"\n            Set m_ListBox = Control\n        Case \"TextBox\"\n            Set m_TextBox = Control\n        Case Control.Name:\n            Set m_UserForm = Control\n    End Select\nEnd Property\n\nPublic Property Get prContextMenu() As CommandBar\n    If m_cbrContextMenu Is Nothing Then\n        Set prContextMenu = Application.CommandBars.Add(m_contextMenuName, Position:=msoBarPopup)\n    Else\n        Set prContextMenu = m_cbrContextMenu\n    End If\nEnd Property\n\nPublic Sub Initialize(ByVal sContextMenuName As String)\n    m_contextMenuName = sContextMenuName\n    Call m_DestroyEditContextMenu\n    Set m_cbrContextMenu = Me.prContextMenu\nEnd Sub\n\n'TypeControl\n'   msoControlButton    1\n'   msoControlEdit      2\n'   msoControlDropdown  3\n'   msoControlComboBox  4\n'   msoControlPopup    10\nPublic Sub addControl(ByVal TypeControl As MsoControlType, _\n        ByVal Caption As String, _\n        ByVal OnAction As String, _\n        Optional FaceId As Integer, _\n        Optional Tag As String = vbNullString, _\n        Optional BeginGroup As Boolean = False)\n\n    If TypeControl = msoControlButton Then\n\n        With m_cbrContextMenu.Controls.Add(Type:=TypeControl)\n            .Caption = Caption\n            .FaceId = FaceId\n            .OnAction = OnAction\n            .Tag = Tag\n            .BeginGroup = BeginGroup\n        End With\n    Else\n        With m_cbrContextMenu.Controls.Add(Type:=TypeControl)\n            .Caption = Caption\n            .OnAction = OnAction\n            .Tag = Tag\n            .BeginGroup = BeginGroup\n        End With\n    End If\nEnd Sub\n\nPublic Sub deleteControlByTag(ByVal Tag As String)\n    Dim btn         As CommandBarControl\n    Set btn = getControlByTag(Tag:=Tag)\n    If Not btn Is Nothing Then btn.Delete\nEnd Sub\n\nPublic Function getControlByTag(ByVal Tag As String) As CommandBarControl\n    Set getControlByTag = m_cbrContextMenu.FindControl(Tag:=Tag)\nEnd Function\n\nPublic Function deleteControlByIdTag(ByVal idTag As String) As Boolean\n    Dim btn         As CommandBarControl\n    Set btn = getControlByTag(idTag)\n    If Not btn Is Nothing Then\n        btn.Delete\n        deleteControlByIdTag = True\n    End If\nEnd Function\n\nPublic Function getControlByIdTag(Optional idTag As String) As CommandBarControl\n    Dim i           As Integer\n    With m_cbrContextMenu\n        If Me.prCountControls = 0 Then Exit Function\n        For i = 1 To .Controls.Count\n            If .Controls(i).Tag = idTag Then\n                Set getControlByIdTag = .Controls(i)\n                Exit For\n            End If\n        Next i\n    End With\nEnd Function\n\nPublic Function deleteControlByIndex(ByVal index As Integer) As Boolean\n    Dim btn         As CommandBarControl\n    Set btn = getControlByIndex(index)\n    If Not btn Is Nothing Then\n        btn.Delete\n        deleteControlByIndex = True\n    End If\nEnd Function\n\nPublic Function getControlByIndex(ByRef index As Integer) As CommandBarControl\n    If Me.prCountControls = 0 Then Exit Function\n    Set getControlByIndex = m_cbrContextMenu.Controls(index)\nEnd Function\n\nPublic Sub showMenu()\n    Me.prContextMenu.ShowPopup\nEnd Sub\n\nPrivate Sub Class_Terminate()\n    Call m_DestroyEditContextMenu\n    Set m_cbrContextMenu = Nothing\nEnd Sub\n\nPrivate Sub m_DestroyEditContextMenu()\n    On Error Resume Next\n    Application.CommandBars(m_contextMenuName).Delete\nEnd Sub", 
      "CODE": "Dim contextMenu     As clsContextMenu\r\n    Set contextMenu = New clsContextMenu\r\n    With contextMenu\r\n        Call .Initialize(\"Your_Name_Bar\")\r\n        Call .addControl(msoControlButton, \"Name_BTN\", \"\")\r\n    End With\r\nPrivate Sub UserForm_Terminate()\r\n    Set contextMenu = Nothing\r\nEnd Sub", 
      "DISCRIPTION": "Контекстное меню"
    }, 
    {
      "CODE_GRUP": "Forms", 
      "CODE_SNIPPET": "clsListBox", 
      "clsListBox.cls": "''* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\n'* Module     : clsComboBox - update listbox\n'* Created    : 25-07-2025 09:38\n'* Author     : VBATools\n'* Contacts   : https://vk.com/vbatools\n'* Copyright  : VBATools.ru\n'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\n'*\n'* DESCRIPTION:   Update ListBox\n'*\n'* PROPERTY:\n'*  Get/Let SortTextBox\n'*  Get     GetArrayIndexSelected\n'*  Get     GetArrayIndexUnSelected\n'*  Get/Let Delimetr\n'*  Get/Let BoundColumn\n'*  Get     Text\n'*  Get/Let ColumnCount\n'*  Get/Let List\n'*  Get     Value\n'*  Get     SelectedCount\n'*  Get     ListSelectedItems\n'*  Get/Let Visible\n'*      Let ListSelectedAll\n'*\n'* PROCEDURES PUBLIC:\n'*  Initialize\n'*  ReversSelected\n'*  RemoveSelected\n'*  RemoveUnSelected\n'*\n'* PROCEDURES PRIVATE:\n'*  addArrayConst - add un selected list 0,1,2,3...\n'*  frmList_Change\n'*  updateArrList\n'*  updatTextInTextBox - add string for textbox with delimetr\n'*  selectItemsList\n'*\n'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\n\nPublic WithEvents frmList As MSForms.ListBox\n\nPrivate msText      As String\nPrivate mDelimetr   As String\nPrivate mListSelectedItems As Variant\nPrivate mValueBoundColumn As Variant\nPrivate mBoundColumn As Long\nPrivate mSortText   As Byte\n'1 - Up Sort\n'2 - Down Sort\n\nPrivate mbChange    As Boolean\nPrivate mBuferText  As String\n'iiaee??eou ?eaeeioaeo mscorlib.dll eee caiaieou  ArrayList ia CreateObject(\"System.Collections.ArrayList\")\nPrivate arrArrayListSelected As ArrayList\nPrivate arrArrayListUnSelected As ArrayList\n\nPrivate Sub Class_Terminate()\n    Set frmList = Nothing\n\n    mDelimetr = Empty\n    mListSelectedItems = Empty\n    mValueBoundColumn = Empty\n    mBoundColumn = Empty\n    mSortText = Empty\n\n    mbChange = Empty\n\n    Set arrArrayListSelected = Nothing\n    Set arrArrayListUnSelected = Nothing\nEnd Sub\n\nPublic Sub ReversSelected()\n    Dim arrArrayListBufer As ArrayList\n    Set arrArrayListBufer = arrArrayListSelected.Clone\n    Set arrArrayListSelected = arrArrayListUnSelected.Clone\n    Set arrArrayListUnSelected = arrArrayListBufer.Clone\n    arrArrayListBufer.Clear\n    frmList.List = frmList.List\n    Call updatTextInTextBox\n    Call selectItemsList\nEnd Sub\n\nPublic Property Get SortTextBox() As Byte\n    SortTextBox = mSortText\nEnd Property\n\nPublic Property Let SortTextBox(ByVal bySort As Byte)\n    mSortText = bySort\n    With arrArrayListSelected\n        Select Case mSortText\n            Case 1\n                Call .Sort\n                arrArrayListUnSelected.Sort\n            Case 2\n                Call .Sort\n                Call .Reverse\n                arrArrayListUnSelected.Sort\n                arrArrayListUnSelected.Reverse\n        End Select\n    End With\nEnd Property\n\nPublic Property Get GetArrayIndexSelected() As Variant\n    GetArrayIndexSelected = arrArrayListSelected.ToArray\nEnd Property\n\nPublic Property Get GetArrayIndexUnSelected() As Variant\n    GetArrayIndexUnSelected = arrArrayListUnSelected.ToArray\nEnd Property\n\nPublic Property Get Delimetr() As String\n    Delimetr = mDelimetr\nEnd Property\n\nPublic Property Let Delimetr(ByVal Delimetr As String)\n    mDelimetr = Delimetr\nEnd Property\n\nPublic Property Let BoundColumn(ByVal Column As Long)\n    If Column < 1 Then Call Err.Raise(Number:=vbObjectError + 100, Description:=\"BoundColumn must be greater than zero\")\n    frmList.BoundColumn = Column\n    mBoundColumn = Column\nEnd Property\n\nPublic Property Get BoundColumn() As Long\n    If mBoundColumn = 0 Then mBoundColumn = frmList.BoundColumn\n    BoundColumn = mBoundColumn\nEnd Property\n\nPublic Property Let Text(ByVal sText As String)\n    Dim arrList     As Variant\n    Dim iCountList  As Long\n\n    msText = sText\n    arrArrayListUnSelected.Clear\n    arrArrayListSelected.Clear\n    Me.List = Me.List\n    arrList = Me.List\n    iCountList = UBound(arrList, 1)\n\n    If iCountList < 0 Or sText = vbNullString Then Exit Property\n    Call addArrayConst(arrArrayListUnSelected, iCountList)\n\n    Dim i           As Long\n    Dim j           As Long\n    Dim bFlag       As Boolean\n    Dim arr         As Variant\n    \n    arr = VBA.Split(sText, mDelimetr)\n    For j = 0 To UBound(arr)\n        For i = 0 To iCountList\n            If arr(j) = VBA.CStr(arrList(i, 0)) Then\n                Call arrArrayListUnSelected.Remove(i)\n                Call arrArrayListSelected.Add(i)\n                bFlag = True\n                Exit For\n            End If\n        Next i\n    Next j\n\n    If bFlag Then\n        Call selectItemsList\n        Call updatTextInTextBox\n    End If\nEnd Property\n\nPublic Property Get Text() As String\n    Text = msText\nEnd Property\n\nPublic Property Let ColumnCount(ByVal iCount As Byte)\n    frmList.ColumnCount = iCount\nEnd Property\n\nPublic Property Get ColumnCount() As Byte\n    ColumnCount = frmList.ColumnCount\nEnd Property\n\nPublic Property Get List() As Variant\n    List = frmList.List\nEnd Property\n\nPublic Property Let List(ByVal arrList As Variant)\n    frmList.List = arrList\n    Call selectItemsList\nEnd Property\n\nPublic Property Get Value() As Variant\n    Call selectItemsList\n    Value = mValueBoundColumn\nEnd Property\n\nPublic Property Get SelectedCount() As Long\n    SelectedCount = arrArrayListSelected.Count\nEnd Property\n\nPublic Property Get ListSelectedItems() As Variant\n    Call selectItemsList\n    ListSelectedItems = mListSelectedItems\nEnd Property\n\nPublic Property Let Visible(ByVal bVisible As Boolean)\n    frmList.Visible = bVisible\nEnd Property\n\nPublic Property Get Visible() As Boolean\n    Visible = frmList.Visible\nEnd Property\n\nPublic Property Let ListSelectedAll(ByVal bSelected As Boolean)\n    Application.ScreenUpdating = True\n    Dim j           As Long\n    Dim jCount      As Long\n    Dim sRes        As String\n    With frmList\n        jCount = .ListCount - 1\n        For j = 0 To jCount\n            mbChange = True\n            .Selected(j) = bSelected\n            mbChange = False\n            If bSelected Then\n                If sRes <> vbNullString Then sRes = sRes & mDelimetr\n                sRes = sRes & .List(j, 0)\n                sRes = putTextToBufer(sRes, j, jCount)\n            End If\n        Next j\n    End With\n    If bSelected Then\n        Me.Text = sRes\n        arrArrayListUnSelected.Clear\n        Call addArrayConst(arrArrayListSelected, jCount)\n    Else\n        Me.Text = vbNullString\n        mListSelectedItems = Empty\n        mValueBoundColumn = Empty\n        arrArrayListSelected.Clear\n        Call addArrayConst(arrArrayListUnSelected, jCount)\n    End If\n    mbChange = False\n    mBuferText = vbNullString\n    Application.ScreenUpdating = False\nEnd Property\n\nPublic Sub Initialize(ByRef cnt As MSForms.ListBox, Optional arrList As Variant = Empty, Optional sDelimetr As String = \", \", Optional SortTextBox As Byte = 1)\n    If Not IsArray(arrList) And Not IsEmpty(arrList) Then\n        Call Err.Raise(Number:=vbObjectError + 200, Description:=\"The arrList is not Array\")\n        Exit Sub\n    End If\n\n    Set frmList = cnt\n    If frmList.MultiSelect <> fmMultiSelectMulti Then\n        Call Err.Raise(Number:=vbObjectError + 201, Description:=\"This class is only for ListBox with MultiSelect\")\n        Exit Sub\n    End If\n\n    mDelimetr = sDelimetr\n    mSortText = SortTextBox\n\n    Set arrArrayListSelected = New ArrayList\n    Set arrArrayListUnSelected = New ArrayList\n\n    If Not IsEmpty(arrList) Then\n        frmList.List = arrList\n        Call addArrayConst(arrArrayListUnSelected, UBound(arrList) - 1)\n    End If\n    Me.SortTextBox = mSortText\nEnd Sub\n\nPrivate Sub frmList_Change()\n    If mbChange Then Exit Sub\n    mbChange = True\n    Dim index       As Long\n    index = frmList.ListIndex\n    If index < 0 Then Exit Sub\n    With arrArrayListSelected\n        If frmList.Selected(index) Then\n            If Not .Contains(index) Then Call .Add(index)\n        Else\n            If .Contains(index) Then Call .Remove(index)\n        End If\n    End With\n\n    With arrArrayListUnSelected\n        If Not frmList.Selected(index) Then\n            If Not .Contains(index) Then Call .Add(index)\n        Else\n            If .Contains(index) Then Call .Remove(index)\n        End If\n    End With\n    Call updatTextInTextBox\n    Me.SortTextBox = mSortText\n    mbChange = False\nEnd Sub\n\nPrivate Sub updatTextInTextBox()\n    Dim sRes        As String\n    Dim j           As Long\n    Dim jCount      As Long\n\n    mbChange = True\n    Me.SortTextBox = mSortText\n    With frmList\n        jCount = arrArrayListSelected.Count - 1\n        For j = 0 To jCount\n            .Selected(arrArrayListSelected(j)) = True\n            If sRes <> vbNullString Then sRes = sRes & mDelimetr\n            sRes = sRes & .List(arrArrayListSelected(j), 0)\n            sRes = putTextToBufer(sRes, j, jCount)\n        Next j\n        msText = sRes\n    End With\n    mbChange = False\n    mBuferText = vbNullString\nEnd Sub\n\nPrivate Sub selectItemsList()\n    Dim i           As Long\n    Dim iCount      As Long\n    Dim m           As Byte\n    Dim mCount      As Byte\n    Dim item        As Long\n\n    With arrArrayListSelected\n        iCount = .Count - 1\n        If iCount < 0 Then\n            mListSelectedItems = Empty\n            mValueBoundColumn = Empty\n            arrArrayListSelected.Clear\n            Call addArrayConst(arrArrayListUnSelected, frmList.ListCount - 1)\n            Exit Sub\n        End If\n        If frmList.ListIndex < 0 Then Exit Sub\n        mCount = frmList.ColumnCount - 1\n        ReDim mListSelectedItems(1 To iCount + 1, 1 To mCount + 1)\n        ReDim mValueBoundColumn(1 To iCount + 1, 1 To 1)\n\n        For i = 0 To iCount\n            item = arrArrayListSelected(i)\n            mValueBoundColumn(i + 1, 1) = frmList.List(item, mBoundColumn - 1)\n            For m = 0 To mCount\n                mListSelectedItems(i + 1, m + 1) = frmList.List(item, m)\n            Next m\n        Next i\n    End With\nEnd Sub\n\n'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\n'* Sub        : RemoveSelected - oaaeeou aua?aiiua a eenoaiena\n'* Created    : 25-07-2025 10:00\n'* Author     : VBATools\n'* Contacts   : https://vk.com/vbatools\n'* Copyright  : VBATools.ru\n'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\nPublic Sub RemoveSelected()\n    Dim i           As Long\n    Dim iCount      As Long\n    With frmList\n        arrArrayListSelected.Sort\n        iCount = arrArrayListSelected.Count - 1\n        If iCount < 0 Then Exit Sub\n        For i = iCount To 0 Step -1\n            Call .RemoveItem(arrArrayListSelected(i))\n        Next i\n        Me.Text = vbNullString\n        arrArrayListSelected.Clear\n        Call addArrayConst(arrArrayListUnSelected, frmList.ListCount - 1)\n    End With\nEnd Sub\n\n'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\n'* Sub        : RemoveUnSelected - oaaeeou IA aua?aiiua a eenoaiena\n'* Created    : 25-07-2025 10:00\n'* Author     : VBATools\n'* Contacts   : https://vk.com/vbatools\n'* Copyright  : VBATools.ru\n'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\nPublic Sub RemoveUnSelected()\n    Call selectItemsList\n    Me.Text = vbNullString\n    arrArrayListSelected.Clear\n    If Not IsEmpty(mListSelectedItems) Then\n        frmList.List = mListSelectedItems\n        Call addArrayConst(arrArrayListUnSelected, frmList.ListCount - 1)\n    Else\n        frmList.Clear\n        arrArrayListUnSelected.Clear\n    End If\nEnd Sub\n\nPrivate Function addArrayConst(ByRef arr As ArrayList, ByRef iCount As Long)\n    Dim i           As Long\n    arr.Clear\n    For i = 0 To iCount\n        Call arr.Add(i)\n    Next i\n    Me.SortTextBox = mSortText\nEnd Function\n\nPrivate Function putTextToBufer(ByRef sVal As String, ByRef itemNumber As LongPtr, ByRef iCount As LongPtr) As String\n    If VBA.Len(sVal) > 1000 Then\n        If mBuferText <> vbNullString Then mBuferText = mBuferText & mDelimetr\n        mBuferText = mBuferText & sVal\n        sVal = vbNullString\n    End If\n    If itemNumber = iCount Then\n        If mBuferText <> vbNullString Then mBuferText = mBuferText & mDelimetr\n        putTextToBufer = mBuferText & sVal\n    Else\n        putTextToBufer = sVal\n    End If\nEnd Function\n", 
      "CODE": "Dim cmb                       As clsListBox\r\nSet cmb = New clsListBox\r\nCall cmb.Initialize(txtBox:=txtValue, arrList:=arr, sDelimetr:=\", \", SortTextBox:=1)", 
      "DISCRIPTION": "Класс, ListBox"
    }, 
    {
      "CODE_GRUP": "Forms", 
      "CODE_SNIPPET": "clsModernStyle", 
      "clsModernStyle.cls": "'========================================================================================\n' Class:           clsModernStyle\n' Author:          VBATools\n' Version:         1.0.9\n' Creation Date:   10.10.2025 15:30\n' Update Date:     03.11.2025 09:01\n'\n' Purpose:\n'   Class designed to style MSForms controls with a modern design.\n'   Implements various visual effects such as focus animation, color and font settings,\n'   adding icons and visual elements.\n'\n' Main Features:\n'   - Applying modern style to various controls (TextBox, ComboBox, ListBox, CheckBox, OptionButton, etc.)\n'   - Supporting focus animation\n'   - Configuring color and font\n'   - Adding icons and visual elements\n'   - Managing visibility and state of controls\n'\n' Usage:\n'   1. Create an instance of clsModernStyle class\n'   2. Call the Initialize method, passing a reference to the UserForm\n'   3. The class automatically applies style to all controls on the form\n'\n' Example Usage:\n'   Dim style As New clsModernStyle\n'   style.Initialize Me ' where Me is the UserForm\n'\n' Dependencies:\n'   - Microsoft Forms 2.0 Object Library\n'   - VBA\n'\n' License:\n'   Apache License\n'========================================================================================\n\n'========================================================================================\n' Enumeration: enumIcons\n' Purpose: Enumeration of icons for various controls\n'========================================================================================\nPublic Enum enumIcons\n    ArrowOff = &HE011                       ' Dropdown list arrow (off)\n    ArrowOn = &HE010                        ' Dropdown list arrow (on)\n    CheckBox1 = 59193                       ' Square (normal)\n    Checkbox14 = 61803                      ' Square (small)\n    CheckboxComposite = 59194               ' Square with checkmark\n    CheckboxComposite14 = 61804             ' Square with checkmark (small)\n    CheckboxCompositeReversed = 59197       ' Square with checkmark (reversed)\n    CheckboxIndeterminateCombo = 61806      ' Square with dash\n    CheckboxIndeterminateCombo14 = 61805    ' Square with dash (small)\n    CheckboxFill = 59195                    ' Square (filled)\n    CheckMark = 59198                       ' Checkmark\n    CircleFill = 59963                      ' Circle (filled)\n    CircleRing = 59962                      ' Circle (outline)\n    FavoriteStar = 59188                    ' Star (normal)\n    FavoriteStarFill = 59189                ' Star (filled)\n    Heart = 60241                           ' Heart (normal)\n    HeartFill = 60242                       ' Heart (filled)\n    InkingColorFill = 60775                 ' Brush (filled)\n    InkingColorOutline = 60774              ' Brush (outline)\n    PaginationDotOutline10 = 61734          ' Dot (outline)\n    PaginationDotSolid10 = 61735            ' Dot (filled)\n    PasswordChar = 149                      ' Character for hiding password\n    RadioBtnOff = 60618                     ' Radio button (off)\n    RadioBtnOn = 60619                      ' Radio button (on)\n    ToggleOff = 60434                       ' Toggle switch (off)\n    ToggleOn = 60433                        ' Toggle switch (on)\n    ToggleThumb = 60436                     ' Toggle switch thumb\nEnd Enum\n\n'========================================================================================\n' Section: Constants\n'========================================================================================\n' Font constants\nPrivate Const FONT_NAME_ICON As String = \"Segoe MDL2 Assets\"\n\n' Constants for control types\nPrivate Const CONTROL_TYPE_TEXTBOX As String = \"TextBox\"\nPrivate Const CONTROL_TYPE_COMBOBOX As String = \"ComboBox\"\nPrivate Const CONTROL_TYPE_LISTBOX As String = \"ListBox\"\nPrivate Const CONTROL_TYPE_CHECKBOX As String = \"CheckBox\"\nPrivate Const CONTROL_TYPE_OPTIONBUTTON As String = \"OptionButton\"\nPrivate Const CONTROL_TYPE_FRAME As String = \"Frame\"\nPrivate Const CONTROL_TYPE_LABEL As String = \"Label\"\nPrivate Const CONTROL_TYPE_COMMANDBUTTON As String = \"CommandButton\"\nPrivate Const CONTROL_TYPE_MULTI_PAGE As String = \"MultiPage\"\nPrivate Const CONTROL_TYPE_IMAGE As String = \"Image\"\nPrivate Const CONTROL_TYPE_TABSTRIP As String = \"TabStrip\"\nPrivate Const CONTROL_TYPE_SCROLLBAR As String = \"ScrollBar\"\nPrivate Const CONTROL_TYPE_SPINBUTTON As String = \"SpinButton\"\n\n' Constants for additional control names\nPrivate Const BAR_BOTTOM As String = \"_barBottom\"\nPrivate Const BAR_TITLE As String = \"_barTitle\"\nPrivate Const BAR_ICON As String = \"_barIcon\"\nPrivate Const BACK_GROUND As String = \"_backGround\"\nPrivate Const DROP_ARROW As String = \"_dropArrow\"\nPrivate Const BTN_CLEAR As String = \"_btnClear\"\nPrivate Const SWITCH_BORDER As String = \"_border\"\nPrivate Const SWITCH_CAPTION As String = \"_caption\"\nPrivate Const SWITCH_THUMB As String = \"_thumb\"\n\n' Constants for control behavior\nPrivate Const CONTROL_SWITCH As String = \"SWITCH\"\n\n'========================================================================================\n' Section: Event Handler Objects\n'========================================================================================\nPrivate WithEvents mUserForm As MSForms.UserForm\n\n' Controls with event handlers\nPrivate WithEvents mTextBox As MSForms.TextBox\nPrivate WithEvents mComboBox As MSForms.ComboBox\nPrivate WithEvents mListBox As MSForms.ListBox\nPrivate WithEvents mFrame As MSForms.Frame\nPrivate WithEvents mLabel As MSForms.label\nPrivate WithEvents mCommandButton As MSForms.CommandButton\nPrivate WithEvents mCheckBox As MSForms.CheckBox\nPrivate WithEvents mOptionButton As MSForms.OptionButton\n\n'========================================================================================\n' Section: Style Elements\n'========================================================================================\n' Collection of all style items\nPrivate mStyleItems As Collection\n\n' Main control variables\nPrivate mControl    As MSForms.control\nPrivate mControlType As String\nPrivate mControlName As String\nPrivate mControlTipText As String\nPrivate mVisible    As Boolean\nPrivate mLocked     As Boolean\nPrivate mEnabled    As Boolean\n\n' Positioning and sizes\nPrivate mTop        As Single\nPrivate mLeft       As Single\nPrivate mHeight     As Single\nPrivate mWidth      As Single\n\n' Font properties\nPrivate mFontSizeTitleOff As Integer\nPrivate mFontSizeTitleOn As Integer\nPrivate mFontName   As String\n\n' Color properties for various elements\nPrivate mColorBarTitleOn As XlRgbColor\nPrivate mColorBarTitleOff As XlRgbColor\nPrivate mColorBarBottomOn As XlRgbColor\nPrivate mColorBarBottomOff As XlRgbColor\nPrivate mColorBackGroundOn As XlRgbColor\nPrivate mColorBackGroundOff As XlRgbColor\nPrivate mColorBarIconOn As XlRgbColor\nPrivate mColorBarIconOff As XlRgbColor\nPrivate mColorDropArrowOn As XlRgbColor\nPrivate mColorDropArrowOff As XlRgbColor\n\n' Colors for toggles and checkboxes\nPrivate mColorTgBorderOn As XlRgbColor\nPrivate mColorTgBorderOff As XlRgbColor\nPrivate mColorChkBoxBtnOn As XlRgbColor\nPrivate mColorChkBoxBtnOff As XlRgbColor\nPrivate mColorChkBoxCaptionOn As XlRgbColor\nPrivate mColorChkBoxCaptionOff As XlRgbColor\n\n' Character properties for arrows and switches\nPrivate mChrDropArrowOn As String\nPrivate mChrDropArrowOff As String\nPrivate mChrChkBoxBtnOn As String\nPrivate mChrChkBoxBtnOff As String\nPrivate mChrOptBoxBtnOn As String\nPrivate mChrOptBoxBtnOff As String\n\n' Additional controls for styling\nPrivate mBarBottom  As MSForms.label\nPrivate mBarTitle   As MSForms.label\nPrivate mBarIcon    As MSForms.label\nPrivate mBackGround As MSForms.label\n\nPrivate WithEvents mDropArrow As MSForms.label\nPrivate WithEvents mBtnClear As MSForms.label\nPrivate WithEvents mTgBorder As MSForms.label\nPrivate WithEvents mChkBoxBtn As MSForms.label\nPrivate WithEvents mChkBoxCaption As MSForms.label\n\n'================================================================================\n' Section: Properties for item collection\n'================================================================================\n' Property: StyleItems\n' Purpose: Gets or sets the collection of all style items\nPublic Property Get StyleItems() As Collection\n    Set StyleItems = mStyleItems\nEnd Property\n\nPublic Property Set StyleItems(ByRef Items As Collection)\n    Set mStyleItems = Items\nEnd Property\n\n'================================================================================\n' Section: Properties for main control\n'================================================================================\n' Property: Control\n' Purpose: Gets or sets the main control being styled\nPublic Property Get control() As MSForms.control\n    Set control = mControl\nEnd Property\n\nPublic Property Set control(ByRef control As MSForms.control)\n    Set mControl = control\nEnd Property\n\n'================================================================================\n' Section: Properties for various control types\n'================================================================================\n' Property: TextBox\n' Purpose: Gets or sets the TextBox control reference\nPublic Property Get TextBox() As MSForms.TextBox\n    Set TextBox = mTextBox\nEnd Property\n\nPublic Property Set TextBox(ByRef TextBox As MSForms.TextBox)\n    Set mTextBox = TextBox\nEnd Property\n\n' Property: ComboBox\n' Purpose: Gets or sets the ComboBox control reference\nPublic Property Get ComboBox() As MSForms.ComboBox\n    Set ComboBox = mComboBox\nEnd Property\n\nPublic Property Set ComboBox(ByRef ComboBox As MSForms.ComboBox)\n    Set mComboBox = ComboBox\nEnd Property\n\n' Property: ListBox\n' Purpose: Gets or sets the ListBox control reference\nPublic Property Get ListBox() As MSForms.ListBox\n    Set ListBox = mListBox\nEnd Property\n\nPublic Property Set ListBox(ByRef ListBox As MSForms.ListBox)\n    Set mListBox = ListBox\nEnd Property\n\n' Property: CheckBox\n' Purpose: Gets or sets the CheckBox control reference\nPublic Property Get CheckBox() As MSForms.CheckBox\n    Set CheckBox = mCheckBox\nEnd Property\n\nPublic Property Set CheckBox(ByRef CheckBox As MSForms.CheckBox)\n    Set mCheckBox = CheckBox\nEnd Property\n\n' Property: OptionButton\n' Purpose: Gets or sets the OptionButton control reference\nPublic Property Get OptionButton() As MSForms.OptionButton\n    Set OptionButton = mOptionButton\nEnd Property\n\nPublic Property Set OptionButton(ByRef OptionButton As MSForms.OptionButton)\n    Set mOptionButton = OptionButton\nEnd Property\n\n' Property: Frame\n' Purpose: Gets or sets the Frame control reference\nPublic Property Get Frame() As MSForms.Frame\n    Set Frame = mFrame\nEnd Property\n\nPublic Property Set Frame(ByRef Frame As MSForms.Frame)\n    Set mFrame = Frame\nEnd Property\n\n' Property: Label\n' Purpose: Gets or sets the Label control reference\nPublic Property Get label() As MSForms.label\n    Set label = mLabel\nEnd Property\n\nPublic Property Set label(ByRef label As MSForms.label)\n    Set mLabel = label\nEnd Property\n\n' Property: CommandButton\n' Purpose: Gets or sets the CommandButton control reference\nPublic Property Get CommandButton() As MSForms.CommandButton\n    Set CommandButton = mCommandButton\nEnd Property\n\nPublic Property Set CommandButton(ByRef CommandButton As MSForms.CommandButton)\n    Set mCommandButton = CommandButton\nEnd Property\n\n'================================================================================\n' Section: Properties for control type and name\n'================================================================================\n' Property: ControlType\n' Purpose: Gets or sets the type of the control (e.g., \"TextBox\", \"ComboBox\")\nPublic Property Get ControlType() As String\n    ControlType = mControlType\nEnd Property\n\nPublic Property Let ControlType(ByVal NameType As String)\n    mControlType = NameType\nEnd Property\n\n' Property: Name\n' Purpose: Gets or sets the name of the control\nPublic Property Get Name() As String\n    Name = mControlName\nEnd Property\n\nPublic Property Let Name(ByVal Name As String)\n    mControlName = Name\nEnd Property\n\n'================================================================================\n' Section: Properties for visibility, locking and availability\n'================================================================================\n' Property: Visible\n' Purpose: Gets or sets the visibility of the control and all associated style elements\nPublic Property Get Visible() As Boolean\n    Visible = mVisible\nEnd Property\nPublic Property Let Visible(ByRef Visible As Boolean)\n    mVisible = Visible\n    If Not mControl Is Nothing Then mControl.Visible = Visible\n    Call SetControlVisibility(mBarBottom, Visible)\n    Call SetControlVisibility(mBarTitle, Visible)\n    Call SetControlVisibility(mBarIcon, Visible)\n    Call SetControlVisibility(mBackGround, Visible)\n    Call SetControlVisibility(mTgBorder, Visible)\n    Call SetControlVisibility(mChkBoxBtn, Visible)\n    Call SetControlVisibility(mChkBoxCaption, Visible)\n    Call SetControlVisibility(mDropArrow, Visible)\n    Call SetControlVisibility(mBtnClear, Visible)\nEnd Property\n\n' Property: Locked\n' Purpose: Gets or sets the locked state of the control and all associated style elements\nPublic Property Get Locked() As Boolean\n    Locked = mLocked\nEnd Property\n\nPublic Property Let Locked(ByRef Locked As Boolean)\n    mLocked = Locked\n    If Not mControl Is Nothing Then mControl.Locked = Locked\n    Call SetControlLock(mBarBottom, Locked)\n    Call SetControlLock(mBarTitle, Locked)\n    Call SetControlLock(mBarIcon, Locked)\n    Call SetControlLock(mBackGround, Locked)\n    Call SetControlLock(mTgBorder, Locked)\n    Call SetControlLock(mChkBoxBtn, Locked)\n    Call SetControlLock(mChkBoxCaption, Locked)\n    Call SetControlLock(mDropArrow, Locked)\n    Call SetControlLock(mBtnClear, Locked)\nEnd Property\n\n' Property: Enabled\n' Purpose: Gets or sets the enabled state of the control and all associated style elements\nPublic Property Get Enabled() As Boolean\n    Enabled = mEnabled\nEnd Property\n\nPublic Property Let Enabled(ByRef Enabled As Boolean)\n    mEnabled = Enabled\n    If Not mControl Is Nothing Then mControl.Enabled = Enabled\n    Call SetControlEnabled(mBarBottom, Enabled)\n    Call SetControlEnabled(mBarTitle, Enabled)\n    Call SetControlEnabled(mBarIcon, Enabled)\n    Call SetControlEnabled(mBackGround, Enabled)\n    Call SetControlEnabled(mTgBorder, Enabled)\n    Call SetControlEnabled(mChkBoxBtn, Enabled)\n    Call SetControlEnabled(mChkBoxCaption, Enabled)\n    Call SetControlEnabled(mDropArrow, Enabled)\n    Call SetControlEnabled(mBtnClear, Enabled)\nEnd Property\n\n'---------------------------------------------------------------------------------------\n' Procedure: SetControlEnabled\n' Purpose: Internal method to set the availability state of a control\n' Parameters:\n'   control - Control to change availability state\n'   isEnabled - Flag for availability state\n'---------------------------------------------------------------------------------------\nPrivate Sub SetControlEnabled(ByRef control As MSForms.control, ByVal isEnabled As Boolean)\n    If Not control Is Nothing Then control.Enabled = isEnabled\nEnd Sub\n\n'---------------------------------------------------------------------------------------\n' Procedure: SetControlVisibility\n' Purpose: Internal method to set the visibility of a control\n' Parameters:\n'   control - Control to change visibility\n'   isVisible - Visibility flag\n'---------------------------------------------------------------------------------------\nPrivate Sub SetControlVisibility(ByRef control As MSForms.control, ByVal isVisible As Boolean)\n    If Not control Is Nothing Then control.Visible = isVisible\nEnd Sub\n\n'---------------------------------------------------------------------------------------\n' Procedure: SetControlLock\n' Purpose: Internal method to set the locking state of a control\n' Parameters:\n'   control - Control to change locking state\n'   isLocked - Flag for locking state\n'---------------------------------------------------------------------------------------\nPrivate Sub SetControlLock(ByRef control As MSForms.control, ByVal isLocked As Boolean)\n    If Not control Is Nothing Then control.Locked = isLocked\nEnd Sub\n\n'================================================================================\n' Section: Properties for tooltip\n'================================================================================\n' Property: ControlTipText\n' Purpose: Gets or sets the tooltip text for the control\nPublic Property Get ControlTipText() As String\n    ControlTipText = mControlTipText\nEnd Property\n\nPublic Property Let ControlTipText(ByVal ControlTipText As String)\n    mControlTipText = ControlTipText\nEnd Property\n\n'================================================================================\n' Section: Properties for style element colors\n'================================================================================\n' Property: ColorBarTitleOn\n' Purpose: Gets or sets the color of the title bar when control is active\nPublic Property Get ColorBarTitleOn() As XlRgbColor\n    ColorBarTitleOn = mColorBarTitleOn\nEnd Property\n\nPublic Property Let ColorBarTitleOn(ByVal Color As XlRgbColor)\n    mColorBarTitleOn = Color\nEnd Property\n\n' Property: ColorBarBottomOn\n' Purpose: Gets or sets the color of the bottom bar when control is active\nPublic Property Get ColorBarBottomOn() As XlRgbColor\n    ColorBarBottomOn = mColorBarBottomOn\nEnd Property\n\nPublic Property Let ColorBarBottomOn(ByVal Color As XlRgbColor)\n    mColorBarBottomOn = Color\nEnd Property\n\n' Property: ColorBarBottomOff\n' Purpose: Gets or sets the color of the bottom bar when control is inactive\nPublic Property Get ColorBarBottomOff() As XlRgbColor\n    ColorBarBottomOff = mColorBarBottomOff\nEnd Property\n\nPublic Property Let ColorBarBottomOff(ByVal Color As XlRgbColor)\n    mColorBarBottomOff = Color\nEnd Property\n\n' Property: ColorBarTitleOff\n' Purpose: Gets or sets the color of the title bar when control is inactive\nPublic Property Get ColorBarTitleOff() As XlRgbColor\n    ColorBarTitleOff = mColorBarTitleOff\nEnd Property\n\nPublic Property Let ColorBarTitleOff(ByVal Color As XlRgbColor)\n    mColorBarTitleOff = Color\nEnd Property\n\n' Property: ColorBackGroundOn\n' Purpose: Gets or sets the background color when control is active\nPublic Property Get ColorBackGroundOn() As XlRgbColor\n    ColorBackGroundOn = mColorBackGroundOn\nEnd Property\n\nPublic Property Let ColorBackGroundOn(ByVal Color As XlRgbColor)\n    mColorBackGroundOn = Color\nEnd Property\n\n' Property: ColorBackGroundOff\n' Purpose: Gets or sets the background color when control is inactive\nPublic Property Get ColorBackGroundOff() As XlRgbColor\n    ColorBackGroundOff = mColorBackGroundOff\nEnd Property\n\nPublic Property Let ColorBackGroundOff(ByVal Color As XlRgbColor)\n    mColorBackGroundOff = Color\nEnd Property\n\n' Property: ColorBarIconOn\n' Purpose: Gets or sets the icon color when control is active\nPublic Property Get ColorBarIconOn() As XlRgbColor\n    ColorBarIconOn = mColorBarIconOn\nEnd Property\n\nPublic Property Let ColorBarIconOn(ByVal Color As XlRgbColor)\n    mColorBarIconOn = Color\nEnd Property\n\n' Property: ColorBarIconOff\n' Purpose: Gets or sets the icon color when control is inactive\nPublic Property Get ColorBarIconOff() As XlRgbColor\n    ColorBarIconOff = mColorBarIconOff\nEnd Property\n\nPublic Property Let ColorBarIconOff(ByVal Color As XlRgbColor)\n    mColorBarIconOff = Color\nEnd Property\n\n' Property: ColorDropArrowOn\n' Purpose: Gets or sets the dropdown arrow color when control is active\nPublic Property Get ColorDropArrowOn() As XlRgbColor\n    ColorDropArrowOn = mColorDropArrowOn\nEnd Property\n\nPublic Property Let ColorDropArrowOn(ByVal Color As XlRgbColor)\n    mColorDropArrowOn = Color\nEnd Property\n\n' Property: ColorDropArrowOff\n' Purpose: Gets or sets the dropdown arrow color when control is inactive\nPublic Property Get ColorDropArrowOff() As XlRgbColor\n    ColorDropArrowOff = mColorDropArrowOff\nEnd Property\n\nPublic Property Let ColorDropArrowOff(ByVal Color As XlRgbColor)\n    mColorDropArrowOff = Color\nEnd Property\n\n'================================================================================\n' Section: Properties for switch colors\n'================================================================================\n' Property: ColorTgBorderOn\n' Purpose: Gets or sets the toggle border color when active\nPublic Property Let ColorTgBorderOn(ByVal Color As XlRgbColor)\n    mColorTgBorderOn = Color\nEnd Property\n\nPublic Property Get ColorTgBorderOn() As XlRgbColor\n    ColorTgBorderOn = mColorTgBorderOn\nEnd Property\n\n' Property: ColorTgBorderOff\n' Purpose: Gets or sets the toggle border color when inactive\nPublic Property Let ColorTgBorderOff(ByVal Color As XlRgbColor)\n    mColorTgBorderOff = Color\nEnd Property\n\nPublic Property Get ColorTgBorderOff() As XlRgbColor\n    ColorTgBorderOff = mColorTgBorderOff\nEnd Property\n\n' Property: ColorChkBoxBtnOn\n' Purpose: Gets or sets the checkbox button color when active\nPublic Property Let ColorChkBoxBtnOn(ByVal Color As XlRgbColor)\n    mColorChkBoxBtnOn = Color\nEnd Property\n\nPublic Property Get ColorChkBoxBtnOn() As XlRgbColor\n    ColorChkBoxBtnOn = mColorChkBoxBtnOn\nEnd Property\n\n' Property: ColorChkBoxBtnOff\n' Purpose: Gets or sets the checkbox button color when inactive\nPublic Property Let ColorChkBoxBtnOff(ByVal Color As XlRgbColor)\n    mColorChkBoxBtnOff = Color\nEnd Property\n\nPublic Property Get ColorChkBoxBtnOff() As XlRgbColor\n    ColorChkBoxBtnOff = mColorChkBoxBtnOff\nEnd Property\n\n' Property: ColorTgFore\n' Purpose: Gets or sets the foreground color for toggle controls\nPublic Property Let ColorTgFore(ByVal Color As XlRgbColor)\n    If Not mChkBoxCaption Is Nothing Then mChkBoxCaption.ForeColor = Color\nEnd Property\n\nPublic Property Get ColorTgFore() As XlRgbColor\n    If Not mChkBoxCaption Is Nothing Then ColorTgFore = mChkBoxCaption.ForeColor\nEnd Property\n\n' Property: ColorChkBoxCaptionOn\n' Purpose: Gets or sets the checkbox caption color when active\nPublic Property Let ColorChkBoxCaptionOn(ByVal Color As Long)\n    mColorChkBoxCaptionOn = Color\nEnd Property\n\nPublic Property Get ColorChkBoxCaptionOn() As Long\n    ColorChkBoxCaptionOn = mColorChkBoxCaptionOn\nEnd Property\n\n' Property: ColorChkBoxCaptionOff\n' Purpose: Gets or sets the checkbox caption color when inactive\nPublic Property Let ColorChkBoxCaptionOff(ByVal Color As Long)\n    mColorChkBoxCaptionOff = Color\nEnd Property\n\nPublic Property Get ColorChkBoxCaptionOff() As Long\n    ColorChkBoxCaptionOff = mColorChkBoxCaptionOff\nEnd Property\n\n'================================================================================\n' Section: Properties for arrow characters\n'================================================================================\n' Property: ChrDropArrowOn\n' Purpose: Gets or sets the character for dropdown arrow when active\nPublic Property Let ChrDropArrowOn(ByVal chr As String)\n    mChrDropArrowOn = chr\nEnd Property\n\nPublic Property Get ChrDropArrowOn() As String\n    ChrDropArrowOn = mChrDropArrowOn\nEnd Property\n\n' Property: ChrDropArrowOff\n' Purpose: Gets or sets the character for dropdown arrow when inactive\nPublic Property Let ChrDropArrowOff(ByVal chr As String)\n    mChrDropArrowOff = chr\nEnd Property\n\nPublic Property Get ChrDropArrowOff() As String\n    ChrDropArrowOff = mChrDropArrowOff\nEnd Property\n\n' Property: ChrChkBoxBtnOn\n' Purpose: Gets or sets the character for checkbox button when active\nPublic Property Let ChrChkBoxBtnOn(ByVal Code As String)\n    mChrChkBoxBtnOn = Code\nEnd Property\n\nPublic Property Get ChrChkBoxBtnOn() As String\n    ChrChkBoxBtnOn = mChrChkBoxBtnOn\nEnd Property\n\n' Property: ChrChkBoxBtnOff\n' Purpose: Gets or sets the character for checkbox button when inactive\nPublic Property Let ChrChkBoxBtnOff(ByVal Code As String)\n    mChrChkBoxBtnOff = Code\nEnd Property\n\nPublic Property Get ChrChkBoxBtnOff() As String\n    ChrChkBoxBtnOff = mChrChkBoxBtnOff\nEnd Property\n\n' Property: ChrOptBoxBtnOn\n' Purpose: Gets or sets the character for option button when active\nPublic Property Let ChrOptBoxBtnOn(ByVal Code As String)\n    mChrOptBoxBtnOn = Code\nEnd Property\n\nPublic Property Get ChrOptBoxBtnOn() As String\n    ChrOptBoxBtnOn = mChrOptBoxBtnOn\nEnd Property\n\n' Property: ChrOptBoxBtnOff\n' Purpose: Gets or sets the character for option button when inactive\nPublic Property Let ChrOptBoxBtnOff(ByVal Code As String)\n    mChrOptBoxBtnOff = Code\nEnd Property\n\nPublic Property Get ChrOptBoxBtnOff() As String\n    ChrOptBoxBtnOff = mChrOptBoxBtnOff\nEnd Property\n\n'================================================================================\n' Section: Properties for positioning and sizes\n'================================================================================\n' Property: Top\n' Purpose: Gets or sets the top position of the control\nPublic Property Get top() As Single\n    top = mTop\nEnd Property\n\nPublic Property Let top(ByVal Size As Single)\n    mTop = Size\nEnd Property\n\n' Property: Left\n' Purpose: Gets or sets the left position of the control\nPublic Property Get left() As Single\n    left = mLeft\nEnd Property\n\nPublic Property Let left(ByVal Size As Single)\n    mLeft = Size\nEnd Property\n\n' Property: Height\n' Purpose: Gets or sets the height of the control\nPublic Property Get height() As Single\n    height = mHeight\nEnd Property\n\nPublic Property Let height(ByVal Size As Single)\n    mHeight = Size\nEnd Property\n\n' Property: Width\n' Purpose: Gets or sets the width of the control\nPublic Property Get width() As Single\n    width = mWidth\nEnd Property\n\nPublic Property Let width(ByVal Size As Single)\n    mWidth = Size\nEnd Property\n\n'================================================================================\n' Section: Properties for font\n'================================================================================\n' Property: FontSizeTitleOff\n' Purpose: Gets or sets the font size for inactive state\nPublic Property Get FontSizeTitleOff() As Integer\n    FontSizeTitleOff = mFontSizeTitleOff\nEnd Property\n\nPublic Property Let FontSizeTitleOff(ByVal Size As Integer)\n    mFontSizeTitleOff = Size\nEnd Property\n\n' Property: FontSizeTitleOn\n' Purpose: Gets or sets the font size for active state\nPublic Property Get FontSizeTitleOn() As Integer\n    FontSizeTitleOn = mFontSizeTitleOn\nEnd Property\n\nPublic Property Let FontSizeTitleOn(ByVal Size As Integer)\n    mFontSizeTitleOn = Size\nEnd Property\n\n' Property: FontName\n' Purpose: Gets or sets the font name for the control\nPublic Property Get FontName() As String\n    FontName = mFontName\nEnd Property\n\nPublic Property Let FontName(ByVal Name As String)\n    mFontName = Name\nEnd Property\n\n'================================================================================\n' Section: Properties for additional style elements\n'================================================================================\n' Property: BarBottom\n' Purpose: Gets or sets the bottom bar label control\nPublic Property Get BarBottom() As MSForms.label\n    Set BarBottom = mBarBottom\nEnd Property\n\nPublic Property Set BarBottom(ByRef label As MSForms.label)\n    Set mBarBottom = label\nEnd Property\n\n' Property: BarTitle\n' Purpose: Gets or sets the title bar label control\nPublic Property Set BarTitle(ByRef label As MSForms.label)\n    Set mBarTitle = label\nEnd Property\n\nPublic Property Get BarTitle() As MSForms.label\n    Set BarTitle = mBarTitle\nEnd Property\n\n' Property: BarIcon\n' Purpose: Gets or sets the icon label control\nPublic Property Set BarIcon(ByRef label As MSForms.label)\n    Set mBarIcon = label\nEnd Property\n\nPublic Property Get BarIcon() As MSForms.label\n    Set BarIcon = mBarIcon\nEnd Property\n\n' Property: BackGround\n' Purpose: Gets or sets the background label control\nPublic Property Set BackGround(ByRef label As MSForms.label)\n    Set mBackGround = label\nEnd Property\n\nPublic Property Get BackGround() As MSForms.label\n    Set BackGround = mBackGround\nEnd Property\n\n' Property: DropArrow\n' Purpose: Gets or sets the dropdown arrow label control\nPublic Property Set DropArrow(ByRef label As MSForms.label)\n    Set mDropArrow = label\nEnd Property\n\nPublic Property Get DropArrow() As MSForms.label\n    Set DropArrow = mDropArrow\nEnd Property\n\n' Property: BtnClear\n' Purpose: Gets or sets the clear button label control\nPublic Property Set BtnClear(ByRef label As MSForms.label)\n    Set mBtnClear = label\nEnd Property\n\nPublic Property Get BtnClear() As MSForms.label\n    Set BtnClear = mBtnClear\nEnd Property\n\n' Property: TgBorder\n' Purpose: Gets or sets the toggle border label control\nPublic Property Set TgBorder(ByRef label As MSForms.label)\n    Set mTgBorder = label\nEnd Property\n\nPublic Property Get TgBorder() As MSForms.label\n    Set TgBorder = mTgBorder\nEnd Property\n\n' Property: ChkBoxBtn\n' Purpose: Gets or sets the checkbox button label control\nPublic Property Set ChkBoxBtn(ByRef label As MSForms.label)\n    Set mChkBoxBtn = label\nEnd Property\n\nPublic Property Get ChkBoxBtn() As MSForms.label\n    Set ChkBoxBtn = mChkBoxBtn\nEnd Property\n\n' Property: ChkBoxCaption\n' Purpose: Gets or sets the checkbox caption label control\nPublic Property Set ChkBoxCaption(ByRef label As MSForms.label)\n    Set mChkBoxCaption = label\nEnd Property\n\nPublic Property Get ChkBoxCaption() As MSForms.label\n    Set ChkBoxCaption = mChkBoxCaption\nEnd Property\n\n' Property: Count\n' Purpose: Gets the number of items in the collection\nPublic Property Get Count() As Byte\n    Count = mStyleItems.Count\nEnd Property\n\n' Property: getItemByIndex\n' Purpose: Gets an item from the collection by index\nPublic Property Get getItemByIndex(ByVal index As Integer) As clsModernStyle\n    On Error GoTo endGetItem\n    Set getItemByIndex = mStyleItems(index)\n    Exit Property\nendGetItem:\n    Err.Clear\nEnd Property\n\n' Property: getItemByName\n' Purpose: Gets an item from the collection by name\nPublic Property Get getItemByName(ByVal Name As String) As clsModernStyle\n    On Error GoTo endGetItem\n    Set getItemByName = mStyleItems(Name)\n    Exit Property\nendGetItem:\n    Err.Clear\nEnd Property\n\n' Property: Version\n' Purpose: Gets version information about the class\nPublic Property Get Version() As String\n    Version = \"Version: 1.0.9\" & vbNewLine & _\n            \"Author: VBATools\" & vbNewLine & _\n            \"License: Apache\" & vbNewLine & _\n            \"Date of creation: 10.10.2025 15:30\" & vbNewLine & _\n            \"Date of update: 03.11.2025 09:01\"\nEnd Property\n\n'================================================================================\n' Section: Initialization and management methods\n'================================================================================\n'---------------------------------------------------------------------------------------\n' Procedure: Initialize\n' Purpose: Initialize style for all form controls\n' Parameters:\n'   Form - Reference to UserForm to which style is applied\n'   ColorBarTitleOn - Title color in active state\n'   ColorBarTitleOff - Title color in inactive state\n'   ColorBarBottomOn - Bottom line color in active state\n'   ColorBarBottomOff - Bottom line color in inactive state\n'   ColorBackGroundOn - Background color in active state\n'   ColorBackGroundOff - Background color inactive state\n'   ColorBarIconOn - Icon color in active state\n'   ColorBarIconOff - Icon color in inactive state\n'   ColorDropArrowOn - Dropdown arrow color in active state\n'   ColorDropArrowOff - Dropdown arrow color in inactive state\n'   ColorTgBorderOn - Switch border color in active state\n'   ColorTgBorderOff - Switch border color in inactive state\n'   ColorChkBoxBtnOn - Checkbox button color in active state\n'   ColorChkBoxBtnOff - Checkbox button color in inactive state\n'   ChrDropArrowOn - Dropdown arrow character in active state\n'   ChrDropArrowOff - Dropdown arrow character in inactive state\n'   ColorChkBoxCaptionOn - Checkbox caption color in active state\n'   ColorChkBoxCaptionOff - Checkbox caption color in inactive state\n'   ChrChkBoxBtnOn - Checkbox button character in active state\n'   ChrChkBoxBtnOff - Checkbox button character in inactive state\n'---------------------------------------------------------------------------------------\nPublic Sub Initialize(ByRef Form As MSForms.UserForm, _\n        Optional ColorBarTitleOn As XlRgbColor = 14854934, _\n        Optional ColorBarTitleOff As XlRgbColor = 10395294, _\n        Optional ColorBarBottomOn As XlRgbColor = 14854934, _\n        Optional ColorBarBottomOff As XlRgbColor = 10395294, _\n        Optional ColorBackGroundOn As XlRgbColor = vbWhite, _\n        Optional ColorBackGroundOff As XlRgbColor = 16447476, _\n        Optional ColorBarIconOn As XlRgbColor = 14854934, _\n        Optional ColorBarIconOff As XlRgbColor = 10395294, _\n        Optional ColorDropArrowOn As XlRgbColor = vbBlack, _\n        Optional ColorDropArrowOff As XlRgbColor = 10395294, _\n        Optional ColorTgBorderOn As XlRgbColor = 14854934, _\n        Optional ColorTgBorderOff As XlRgbColor = 10395294, _\n        Optional ColorChkBoxBtnOn As XlRgbColor = vbBlack, _\n        Optional ColorChkBoxBtnOff As XlRgbColor = 10395294, _\n        Optional ChrDropArrowOn As enumIcons = ArrowOn, _\n        Optional ChrDropArrowOff As enumIcons = ArrowOff, _\n        Optional ColorChkBoxCaptionOn As XlRgbColor = 14854934, _\n        Optional ColorChkBoxCaptionOff As XlRgbColor = 10395294, _\n        Optional ChrChkBoxBtnOn As enumIcons = CheckboxComposite, _\n        Optional ChrChkBoxBtnOff As enumIcons = CheckBox1, _\n        Optional ChrOptBoxBtnOn As enumIcons = CircleFill, _\n        Optional ChrOptBoxBtnOff As enumIcons = CircleRing)\n\n    On Error GoTo ErrorHandler\n    Set mUserForm = Form\n    If mStyleItems Is Nothing Then Set mStyleItems = New Collection\n    Dim cntrl       As MSForms.control\n    Dim itemStyle   As clsModernStyle\n\n    ' Loop through all controls on the form\n    For Each cntrl In mUserForm.Controls\n        ' Check if control already exists in collection to avoid duplicates\n        If Not IsControlInCollection(cntrl.Name) Then\n            If Not IsControlInClass(cntrl.Name) Then\n                Set itemStyle = New clsModernStyle\n                With itemStyle\n                    Set .control = cntrl\n                    .ControlType = TypeName(.control)\n\n                    .Visible = .control.Visible\n                    .Enabled = .control.Enabled\n                    Select Case .ControlType\n                        Case CONTROL_TYPE_LABEL, CONTROL_TYPE_FRAME, CONTROL_TYPE_MULTI_PAGE, _\n                                CONTROL_TYPE_IMAGE, CONTROL_TYPE_TABSTRIP, CONTROL_TYPE_SCROLLBAR, CONTROL_TYPE_SPINBUTTON\n                        Case Else\n                            .Locked = .control.Locked\n                    End Select\n\n                    ' Setting default colors\n                    .ColorBarTitleOn = ColorBarTitleOn\n                    .ColorBarTitleOff = ColorBarTitleOff\n                    .ColorBarBottomOn = ColorBarBottomOn\n                    .ColorBarBottomOff = ColorBarBottomOff\n                    .ColorBackGroundOn = ColorBackGroundOn\n                    .ColorBackGroundOff = ColorBackGroundOff\n                    .ColorBarIconOn = ColorBarIconOn\n                    .ColorBarIconOff = ColorBarIconOff\n                    .ColorDropArrowOn = ColorDropArrowOn\n                    .ColorDropArrowOff = ColorDropArrowOff\n\n                    .ColorTgBorderOff = ColorTgBorderOff\n                    .ColorTgBorderOn = ColorTgBorderOn\n                    .ColorChkBoxBtnOff = ColorChkBoxBtnOff\n                    .ColorChkBoxBtnOn = ColorChkBoxBtnOn\n\n                    .ColorChkBoxCaptionOn = ColorChkBoxCaptionOn\n                    .ColorChkBoxCaptionOff = ColorChkBoxCaptionOff\n\n                    ' Setting characters for arrow\n                    .ChrDropArrowOn = VBA.ChrW(ChrDropArrowOn)\n                    .ChrDropArrowOff = VBA.ChrW$(ChrDropArrowOff)\n\n                    .ChrChkBoxBtnOff = VBA.ChrW(ChrChkBoxBtnOff)\n                    .ChrChkBoxBtnOn = VBA.ChrW(ChrChkBoxBtnOn)\n\n                    .ChrOptBoxBtnOff = VBA.ChrW(ChrOptBoxBtnOff)\n                    .ChrOptBoxBtnOn = VBA.ChrW(ChrOptBoxBtnOn)\n\n                    ' Setting main properties\n                    .ControlTipText = .control.ControlTipText\n                    .Name = .control.Name\n                    .top = .control.top\n                    .left = .control.left\n                    .height = .control.height\n                    .width = .control.width\n\n                    Select Case .ControlType\n                        Case CONTROL_TYPE_IMAGE, CONTROL_TYPE_SCROLLBAR, CONTROL_TYPE_SPINBUTTON\n                        Case Else:\n                            .FontSizeTitleOff = .control.Font.Size\n                            .FontSizeTitleOn = .FontSizeTitleOff * 0.95\n                            .FontName = .control.Font.Name\n                    End Select\n\n                    ' Applying style depending on control type\n                    Call ApplyControlStyle(itemStyle)\n\n                    Call mStyleItems.Add(itemStyle, .Name)\n                    Set .StyleItems = mStyleItems\n\n                    ' Activating style for elements with already entered values\n                    Select Case .ControlType\n                        Case CONTROL_TYPE_TEXTBOX, CONTROL_TYPE_COMBOBOX, CONTROL_TYPE_LISTBOX\n                            If .control.Value <> vbNullString Then Call HandleEnterEvent\n                    End Select\n                End With\n            End If\n        End If\n    Next cntrl\n    Exit Sub\n\nErrorHandler:\n    ' Error handling\n    MsgBox \"Error initializing style: \" & Err.Description, vbCritical\nEnd Sub\n\n'================================================================================\n' Section: Methods for setting control styles\n'================================================================================\n'---------------------------------------------------------------------------------------\n' Procedure: ApplyControlStyle\n' Purpose: Method to apply style depending on control type\n' Parameters:\n'   itemStyle - Style object for configuration\n'---------------------------------------------------------------------------------------\nPrivate Sub ApplyControlStyle(ByRef itemStyle As clsModernStyle)\n    With itemStyle\n        Select Case .ControlType\n            Case CONTROL_TYPE_TEXTBOX\n                Set .TextBox = itemStyle.control\n                Call setTextBoxStyle(itemStyle)\n                Call addBarBottom(itemStyle)\n                Call addBarTitle(itemStyle)\n                Call addBarIcon(itemStyle)\n                Call addBackGround(itemStyle)\n                Call addBtnClear(itemStyle)\n            Case CONTROL_TYPE_COMBOBOX\n                Set .ComboBox = itemStyle.control\n                Call setComboBoxStyle(itemStyle)\n                Call addBarBottom(itemStyle)\n                Call addBarTitle(itemStyle)\n                Call addBarIcon(itemStyle)\n                Call addBackGround(itemStyle)\n                Call addDropArrow(itemStyle)\n                Call addBtnClear(itemStyle)\n            Case CONTROL_TYPE_LISTBOX\n                Set .ListBox = itemStyle.control\n                Call setListBoxStyle(itemStyle)\n                Call addBarBottom(itemStyle)\n                Call addBarTitle(itemStyle)\n                Call addBarIcon(itemStyle)\n            Case CONTROL_TYPE_CHECKBOX\n                Set .CheckBox = itemStyle.control\n                If .control.Tag = CONTROL_SWITCH Then\n                    Call addCheckBoxSwitch(itemStyle)\n                Else\n                    Call addCheckBox(itemStyle, .ChrChkBoxBtnOff, .ChrChkBoxBtnOn)\n                End If\n            Case CONTROL_TYPE_OPTIONBUTTON\n                Set .OptionButton = itemStyle.control\n                If .control.Tag = CONTROL_SWITCH Then\n                    Call addCheckBoxSwitch(itemStyle)\n                Else\n                    Call addCheckBox(itemStyle, .ChrOptBoxBtnOff, .ChrOptBoxBtnOn)\n                End If\n            Case CONTROL_TYPE_FRAME\n                Set .Frame = itemStyle.control\n            Case CONTROL_TYPE_LABEL\n                Set .label = itemStyle.control\n            Case CONTROL_TYPE_COMMANDBUTTON\n                Set .CommandButton = itemStyle.control\n        End Select\n    End With\nEnd Sub\n\n'---------------------------------------------------------------------------------------\n' Procedure: SetCommonStyleProperties\n' Purpose: Setting common style properties for a control\n' Parameters:\n'   itemStyle - Style object for configuration\n'---------------------------------------------------------------------------------------\nPrivate Sub SetCommonStyleProperties(ByRef itemStyle As clsModernStyle)\n    With itemStyle\n        With .control\n            .BackStyle = fmBackStyleTransparent\n            .BorderStyle = fmBorderStyleNone\n            .SpecialEffect = fmSpecialEffectFlat\n            .SelectionMargin = False\n            .Font.Name = itemStyle.FontName\n            .Font.Size = itemStyle.FontSizeTitleOff\n        End With\n    End With\nEnd Sub\n\n'---------------------------------------------------------------------------------------\n' Procedure: setTextBoxStyle\n' Purpose: Setting style for text box\n' Parameters:\n'   itemStyle - Style object for configuration\n'   sPasswordChar - Character for displaying password field (optional parameter)\n'---------------------------------------------------------------------------------------\nPrivate Sub setTextBoxStyle(ByRef itemStyle As clsModernStyle, _\n        Optional sPasswordChar As String = vbNullString)\n    Call SetCommonStyleProperties(itemStyle)\n    With itemStyle\n        With .control\n            If VBA.LCase$(itemStyle.Name) Like \"*password*\" Then\n                If sPasswordChar = vbNullString Then sPasswordChar = VBA.ChrW$(PasswordChar)\n                .PasswordChar = sPasswordChar\n            End If\n        End With\n    End With\nEnd Sub\n\n'---------------------------------------------------------------------------------------\n' Procedure: setComboBoxStyle\n' Purpose: Setting style for combo box\n' Parameters:\n'   itemStyle - Style object for configuration\n'---------------------------------------------------------------------------------------\nPrivate Sub setComboBoxStyle(ByRef itemStyle As clsModernStyle)\n    Call SetCommonStyleProperties(itemStyle)\n    With itemStyle\n        With .control\n            .BackColor = itemStyle.ColorBackGroundOff\n            .ShowDropButtonWhen = fmShowDropButtonWhenNever\n            '.BorderStyle = fmBorderStyleSingle\n            .height = 20\n        End With\n    End With\nEnd Sub\n\n'---------------------------------------------------------------------------------------\n' Procedure: setListBoxStyle\n' Purpose: Setting style for list box\n' Parameters:\n'   itemStyle - Style object for configuration\n'---------------------------------------------------------------------------------------\nPrivate Sub setListBoxStyle(ByRef itemStyle As clsModernStyle)\n    With itemStyle\n        With .control\n            .BorderStyle = fmBorderStyleSingle\n            .IntegralHeight = False\n            .Font.Name = itemStyle.FontName\n            .BackColor = itemStyle.ColorBackGroundOff\n            .Font.Size = itemStyle.FontSizeTitleOff\n        End With\n    End With\nEnd Sub\n\n'================================================================================\n' Section: Methods for adding styles to controls\n'================================================================================\n'---------------------------------------------------------------------------------------\n' Function: CreateStyledLabel\n' Purpose: Creating and configuring main properties of additional element\n' Parameters:\n'   itemStyle - Style object for configuration\n'   controlName - Name of control\n'   zIndex - Element placement order (default 1)\n' Returns: New MSForms.label control\n'---------------------------------------------------------------------------------------\nPrivate Function CreateStyledLabel(ByRef itemStyle As clsModernStyle, _\n        ByVal controlName As String, _\n        Optional ByVal zIndex As Integer = 1) As MSForms.label\n    Set CreateStyledLabel = itemStyle.control.Parent.Controls.Add(\"Forms.Label.1\", itemStyle.Name & controlName)\n    With CreateStyledLabel\n        .Visible = itemStyle.Visible\n        .ZOrder zIndex\n    End With\nEnd Function\n\n'---------------------------------------------------------------------------------------\n' Procedure: SetCommonFontProperties\n' Purpose: Setting common font properties for a control\n' Parameters:\n'   label - MSForms.label control\n'   itemStyle - Style object for configuration\n'---------------------------------------------------------------------------------------\nPrivate Sub SetCommonFontProperties(ByRef label As MSForms.label, ByRef itemStyle As clsModernStyle)\n    With label\n        .Font.Name = itemStyle.FontName\n        .Font.Size = itemStyle.FontSizeTitleOff\n    End With\nEnd Sub\n\n'---------------------------------------------------------------------------------------\n' Procedure: addBarBottom\n' Purpose: Adding bottom style line for control\n' Parameters:\n'   itemStyle - Style object for configuration\n'---------------------------------------------------------------------------------------\nPrivate Sub addBarBottom(ByRef itemStyle As clsModernStyle)\n    With itemStyle\n        Set .BarBottom = CreateStyledLabel(itemStyle, BAR_BOTTOM, 1)\n        Call ConfigureStyleElement(.BarBottom, _\n                itemStyle.width, _\n                1, _\n                itemStyle.left, _\n                itemStyle.top + itemStyle.height)\n        With .BarBottom\n            .BackColor = itemStyle.ColorBarBottomOff\n        End With\n    End With\nEnd Sub\n\n'---------------------------------------------------------------------------------------\n' Procedure: addBarTitle\n' Purpose: Adding style title for control\n' Parameters:\n'   itemStyle - Style object for configuration\n'---------------------------------------------------------------------------------------\nPrivate Sub addBarTitle(ByRef itemStyle As clsModernStyle)\n    With itemStyle\n        Set .BarTitle = CreateStyledLabel(itemStyle, BAR_TITLE, 1)\n        Dim titleLeft As Single, titleTop As Single\n        titleLeft = itemStyle.left + 2\n        titleTop = itemStyle.top\n        If itemStyle.ControlType = CONTROL_TYPE_LISTBOX Then\n            titleTop = itemStyle.top - 17\n            titleLeft = itemStyle.left\n        End If\n        Call ConfigureStyleElement(itemStyle.BarTitle, _\n                itemStyle.width, _\n                itemStyle.height, _\n                titleLeft, _\n                titleTop)\n        With .BarTitle\n            .Caption = itemStyle.ControlTipText\n            .ForeColor = itemStyle.ColorBarTitleOff\n            Call SetCommonFontProperties(itemStyle.BarTitle, itemStyle)\n            .BackStyle = fmBackStyleTransparent\n        End With\n    End With\nEnd Sub\n\n'---------------------------------------------------------------------------------------\n' Procedure: addBarIcon\n' Purpose: Adding style icon for control\n' Parameters:\n'   itemStyle - Style object for configuration\n'---------------------------------------------------------------------------------------\nPrivate Sub addBarIcon(ByRef itemStyle As clsModernStyle)\n    With itemStyle\n        Set .BarIcon = CreateStyledLabel(itemStyle, BAR_ICON, 1)\n        Call ConfigureStyleElement(itemStyle.BarIcon, _\n                20, _\n                20, _\n                itemStyle.left - 20, _\n                itemStyle.top + 2)\n        With .BarIcon\n            .Font.Name = FONT_NAME_ICON    '\"icon-font\" '\n            .Font.Size = 15\n            .Font.Bold = True\n            .TextAlign = fmTextAlignCenter\n            If itemStyle.control.Tag <> vbNullString Then .Caption = VBA.ChrW$(itemStyle.control.Tag)\n            .ForeColor = itemStyle.ColorBarIconOff\n            .BackStyle = fmBackStyleTransparent\n        End With\n    End With\nEnd Sub\n\n'---------------------------------------------------------------------------------------\n' Procedure: addBackGround\n' Purpose: Adding style background for control\n' Parameters:\n'   itemStyle - Style object for configuration\n'---------------------------------------------------------------------------------------\nPrivate Sub addBackGround(ByRef itemStyle As clsModernStyle)\n    With itemStyle\n        Set .BackGround = CreateStyledLabel(itemStyle, BACK_GROUND, 1)\n        Call ConfigureStyleElement(itemStyle.BackGround, _\n                itemStyle.width, _\n                itemStyle.height + 4, _\n                itemStyle.left, _\n                itemStyle.top - 4)\n        With .BackGround\n            .BackColor = itemStyle.ColorBackGroundOff\n            Call SetCommonFontProperties(itemStyle.BackGround, itemStyle)\n        End With\n    End With\nEnd Sub\n\n'---------------------------------------------------------------------------------------\n' Procedure: addDropArrow\n' Purpose: Adding dropdown arrow style for control\n' Parameters:\n'   itemStyle - Style object for configuration\n'---------------------------------------------------------------------------------------\nPrivate Sub addDropArrow(ByRef itemStyle As clsModernStyle)\n    With itemStyle\n        Set .DropArrow = CreateStyledLabel(itemStyle, DROP_ARROW, 0)\n        Call ConfigureStyleElement(itemStyle.DropArrow, _\n                13, _\n                itemStyle.height, _\n                itemStyle.width + itemStyle.left - 13, _\n                itemStyle.top)\n        With .DropArrow\n            .Font.Name = FONT_NAME_ICON\n            .Caption = itemStyle.ChrDropArrowOff\n            .TextAlign = fmTextAlignCenter\n            .BackColor = itemStyle.ColorBackGroundOff\n            .ForeColor = itemStyle.ColorDropArrowOff\n            .BorderStyle = fmBorderStyleNone\n            Call SetCommonFontProperties(itemStyle.DropArrow, itemStyle)\n        End With\n    End With\nEnd Sub\n\n'---------------------------------------------------------------------------------------\n' Procedure: addBtnClear\n' Purpose: Adding clear button style for control\n' Parameters:\n'   itemStyle - Style object for configuration\n'---------------------------------------------------------------------------------------\nPrivate Sub addBtnClear(ByRef itemStyle As clsModernStyle)\n    With itemStyle\n        Set .BtnClear = CreateStyledLabel(itemStyle, BTN_CLEAR, 0)\n        Call ConfigureStyleElement(itemStyle.BtnClear, _\n                10, _\n                itemStyle.height, _\n                itemStyle.width + itemStyle.left + 2, _\n                itemStyle.top)\n        With .BtnClear\n            .Font.Name = FONT_NAME_ICON\n            .Caption = VBA.ChrW$(59719)\n            .BackStyle = fmBackStyleTransparent\n            .ForeColor = itemStyle.ColorDropArrowOff\n            .BorderStyle = fmBorderStyleNone\n            .Visible = False\n        End With\n    End With\nEnd Sub\n\n'---------------------------------------------------------------------------------------\n' Procedure: addCheckBox\n' Purpose: Adding checkbox style for control\n' Parameters:\n'   itemStyle - Style object for configuration\n'---------------------------------------------------------------------------------------\nPrivate Sub addCheckBox(ByRef itemStyle As clsModernStyle, ByRef ChrChkBoxBtnOff As String, ByRef ChrChkBoxBtnOn As String)\n    With itemStyle\n\n        .control.Font.Size = 8\n        If .control.height < 20 Then .control.height = 20\n\n        Set .ChkBoxBtn = .control.Parent.Controls.Add(\"Forms.Label.1\", .control.Name & SWITCH_THUMB)\n\n        .ChkBoxBtn.left = .control.left\n        .ChkBoxBtn.top = .control.top\n        .ChkBoxBtn.width = .control.width\n        .ChkBoxBtn.height = .control.height\n        .ChkBoxBtn.Font.Name = FONT_NAME_ICON\n        .ChkBoxBtn.Font.Size = .control.Font.Size * 1.5\n\n        If .control.Value Then\n            .ChkBoxBtn.Caption = ChrChkBoxBtnOn\n            .ChkBoxBtn.ForeColor = .ColorChkBoxBtnOn\n        Else\n            .ChkBoxBtn.Caption = ChrChkBoxBtnOff\n            .ChkBoxBtn.ForeColor = .ColorChkBoxBtnOff\n        End If\n\n        '.ChkBoxBtn.BackStyle = fmBackStyleTransparent\n        '.ChkBoxBtn.BorderStyle = fmBorderStyleSingle\n\n        If .control.width - 15 > 0 Then\n\n            Set .ChkBoxCaption = .control.Parent.Controls.Add(\"Forms.Label.1\", .control.Name & SWITCH_CAPTION)\n\n            .ChkBoxCaption.left = .control.left + 15\n            .ChkBoxCaption.top = .control.top + 1\n            .ChkBoxCaption.width = .control.width - 15\n            .ChkBoxCaption.height = .control.height\n            .ChkBoxCaption.Font.Name = .control.Font.Name\n            .ChkBoxCaption.Font.Size = .control.Font.Size\n            .ChkBoxCaption.Caption = .control.Caption\n            .ChkBoxCaption.BackColor = .control.BackColor\n            .ChkBoxCaption.ForeColor = .ColorChkBoxCaptionOff\n            .ChkBoxCaption.ZOrder (0)\n\n            If .control.Value Then\n                .ChkBoxCaption.ForeColor = .ColorChkBoxCaptionOn\n            Else\n                .ChkBoxCaption.ForeColor = .ColorChkBoxCaptionOff\n            End If\n\n            '.ChkBoxCaption.BackStyle = fmBackStyleTransparent\n            '.ChkBoxCaption.BorderStyle = fmBorderStyleSingle\n        End If\n\n        If .control.Value Then\n            .ChkBoxBtn.Caption = ChrChkBoxBtnOn\n            .ChkBoxBtn.ForeColor = .ColorChkBoxBtnOn\n            If .control.width - 15 > 0 Then .ChkBoxCaption.ForeColor = .ColorChkBoxCaptionOn\n        End If\n    End With\nEnd Sub\n\n'---------------------------------------------------------------------------------------\n' Procedure: addCheckBoxSwitch\n' Purpose: Adding switch style for control\n' Parameters:\n'   itemStyle - Style object for configuration\n'---------------------------------------------------------------------------------------\nPrivate Sub addCheckBoxSwitch(ByRef itemStyle As clsModernStyle)\n    With itemStyle\n        .control.Font.Size = 8\n        If .control.height < 20 Then .control.height = 20\n\n        Set .TgBorder = .control.Parent.Controls.Add(\"Forms.Label.1\", .Name & SWITCH_BORDER)\n        .TgBorder.Visible = .Visible\n        .TgBorder.left = .control.left\n        .TgBorder.top = .control.top\n        .TgBorder.width = .control.width\n        If .TgBorder.width < 28 Then .TgBorder.width = 28\n\n        .TgBorder.height = .control.height\n        .TgBorder.Font.Name = FONT_NAME_ICON\n        .TgBorder.Font.Size = .control.Font.Size * 3.25\n        .TgBorder.BackColor = .control.BackColor\n        If .control.Value Then\n            .TgBorder.ForeColor = .ColorTgBorderOn\n            .TgBorder.Caption = VBA.ChrW(ToggleOn)\n        Else\n            .TgBorder.ForeColor = .ColorTgBorderOff\n            .TgBorder.Caption = VBA.ChrW(ToggleOff)\n        End If\n\n        '.TgBorder.BackStyle = fmBackStyleTransparent\n        '.TgBorder.BorderStyle = fmBorderStyleSingle\n\n        If .control.width - 29 > 0 Then\n\n            Set .ChkBoxCaption = .control.Parent.Controls.Add(\"Forms.Label.1\", .Name & SWITCH_CAPTION)\n\n            .ChkBoxCaption.Visible = .Visible\n            .ChkBoxCaption.left = .TgBorder.left + 29\n            .ChkBoxCaption.top = .TgBorder.top + 8\n            .ChkBoxCaption.width = .control.width - 29\n            .ChkBoxCaption.height = .control.height * 0.6\n            .ChkBoxCaption.Font.Name = .control.Font.Name\n            .ChkBoxCaption.Font.Size = .control.Font.Size\n            .ChkBoxCaption.Caption = .control.Caption\n            .ChkBoxCaption.BackColor = .control.BackColor\n            '.ChkBoxCaption.ForeColor = .Control.ForeColor\n            '.ChkBoxCaption.BackStyle = fmBackStyleTransparent\n            '.ChkBoxCaption.BorderStyle = fmBorderStyleSingle\n\n            If .control.Value Then\n                .ChkBoxCaption.ForeColor = .ColorChkBoxCaptionOn\n            Else\n                .ChkBoxCaption.ForeColor = .ColorChkBoxCaptionOff\n            End If\n        End If\n\n        Set .ChkBoxBtn = .control.Parent.Controls.Add(\"Forms.Label.1\", .Name & SWITCH_THUMB)\n\n        .ChkBoxBtn.Visible = .Visible\n        .ChkBoxBtn.top = .control.top + 9.5\n        .ChkBoxBtn.width = .TgBorder.width\n        .ChkBoxBtn.height = .control.height\n        .ChkBoxBtn.Font.Name = FONT_NAME_ICON\n        .ChkBoxBtn.Font.Size = .control.Font.Size * 0.9\n        .ChkBoxBtn.Caption = VBA.ChrW(ToggleThumb)\n        .ChkBoxBtn.BackStyle = fmBackStyleTransparent\n        .ChkBoxBtn.BackColor = .control.BackColor\n        If .control.Value Then\n            .ChkBoxBtn.left = .control.left + 17\n            .ChkBoxBtn.ForeColor = .ColorChkBoxBtnOn\n        Else\n            .ChkBoxBtn.ForeColor = .ColorChkBoxBtnOff\n            .ChkBoxBtn.left = .left + 2\n        End If\n\n        .ChkBoxBtn.ZOrder (0)\n        '.TgBorder.BorderStyle = fmBorderStyleSingle\n\n        If .control.Value Then\n            .ChkBoxBtn.ForeColor = .ColorChkBoxBtnOn\n            .TgBorder.ForeColor = .ColorTgBorderOn\n        End If\n    End With\nEnd Sub\n\n'---------------------------------------------------------------------------------------\n' Procedure: HandleExitEvent\n' Purpose: Reset style for all controls\n'---------------------------------------------------------------------------------------\nPrivate Sub HandleExitEvent()\n    Dim item        As clsModernStyle\n    For Each item In Me.StyleItems\n        Call exitControl(item)\n    Next item\nEnd Sub\n\n'---------------------------------------------------------------------------------------\n' Procedure: exitControl\n' Purpose: Reset control style on focus loss\n' Parameters:\n'   itemStyle - Style object for configuration\n'---------------------------------------------------------------------------------------\nPrivate Sub exitControl(ByRef itemStyle As clsModernStyle)\n    With itemStyle\n        If Not IsControlActive(itemStyle) Then Exit Sub\n        Select Case .ControlType\n            Case CONTROL_TYPE_TEXTBOX, CONTROL_TYPE_COMBOBOX, CONTROL_TYPE_LISTBOX:\n                With .BarTitle\n                    If VBA.Len(Trim(itemStyle.control.Value)) = 0 Then\n                        .ForeColor = itemStyle.ColorBarTitleOff\n                        .top = itemStyle.top\n                        .left = itemStyle.left + 2\n                        .Font.Size = itemStyle.FontSizeTitleOff\n                        Call btnClearVisible(itemStyle, False)\n                    Else\n                        .ForeColor = itemStyle.ColorBarTitleOn\n                        .top = itemStyle.top - 17\n                        .left = itemStyle.left\n                        .Font.Size = itemStyle.FontSizeTitleOn\n                        If itemStyle.ControlType = CONTROL_TYPE_LISTBOX Then .ForeColor = itemStyle.ColorBarTitleOff\n                        Call btnClearVisible(itemStyle, True)\n                    End If\n                End With\n\n                With .BarBottom\n                    .BackColor = itemStyle.ColorBarBottomOff\n                    .height = 1\n                End With\n\n                If Not .BackGround Is Nothing Then\n                    .BackGround.BackColor = itemStyle.ColorBackGroundOff\n                End If\n\n                .BarIcon.ForeColor = itemStyle.ColorBarIconOff\n\n                If Not .DropArrow Is Nothing Then\n                    With .DropArrow\n                        .ForeColor = itemStyle.ColorDropArrowOff\n                        .BackColor = itemStyle.ColorBackGroundOff\n                        .Caption = itemStyle.ChrDropArrowOff\n                    End With\n                End If\n        End Select\n    End With\nEnd Sub\n\n'---------------------------------------------------------------------------------------\n' Procedure: btnClearVisible\n' Purpose: Managing visibility of clear button for control\n' Parameters:\n'   itemStyle - Style object for configuration\n'   bVisible - Button visibility flag\n'---------------------------------------------------------------------------------------\nPrivate Sub btnClearVisible(ByRef itemStyle As clsModernStyle, ByRef bVisible As Boolean)\n    If itemStyle.BtnClear Is Nothing Then Exit Sub\n    itemStyle.BtnClear.Visible = bVisible\nEnd Sub\n\n'---------------------------------------------------------------------------------------\n' Procedure: HandleEnterEvent\n' Purpose: Activating control style on focus gain\n'---------------------------------------------------------------------------------------\nPrivate Sub HandleEnterEvent()\n    Call HandleExitEvent\n    With Me\n        If .control Is Nothing Then Exit Sub\n        If Not IsControlActive(Me) Then Exit Sub\n        .Visible = True\n        Select Case .ControlType\n            Case CONTROL_TYPE_TEXTBOX, CONTROL_TYPE_LISTBOX, CONTROL_TYPE_COMBOBOX:\n                With .BarBottom\n                    .BackColor = Me.ColorBarBottomOn\n                    .height = 1.2\n                End With\n\n                With mBarTitle\n                    .ForeColor = Me.ColorBarTitleOn\n                    .top = Me.top - 17\n                    .Font.Size = Me.FontSizeTitleOn\n                    .left = Me.left\n                End With\n\n                If Not .BackGround Is Nothing Then\n                    .BackGround.BackColor = .ColorBackGroundOn\n                End If\n\n                .BarIcon.ForeColor = .ColorBarIconOn\n\n                If Not .DropArrow Is Nothing Then\n                    .DropArrow.ForeColor = .ColorDropArrowOn\n                    .DropArrow.BackColor = .ColorBackGroundOn\n                    Call mDropArrow_Click\n                End If\n        End Select\n    End With\nEnd Sub\n\n'================================================================================\n' Section: Control event handling\n'================================================================================\n' Event handlers for style activation (focusing on element)\nPrivate Sub mListBox_Change()\n    Call HandleEnterEvent\nEnd Sub\n\nPrivate Sub mListBox_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)\n    Call HandleEnterEvent\nEnd Sub\n\nPrivate Sub mListBox_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)\n    Call HandleEnterEvent\nEnd Sub\n\nPrivate Sub mTextBox_Change()\n    Call HandleEnterEvent\nEnd Sub\n\nPrivate Sub mTextbox_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)\n    Call HandleEnterEvent\nEnd Sub\n\nPrivate Sub mTextbox_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)\n    Call HandleEnterEvent\nEnd Sub\n\nPrivate Sub mComboBox_Change()\n    Call HandleEnterEvent\nEnd Sub\n\nPrivate Sub mComboBox_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)\n    Call HandleEnterEvent\nEnd Sub\n\nPrivate Sub mComboBox_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)\n    Call HandleEnterEvent\nEnd Sub\n\n' Event handlers for style reset (focus loss)\nPrivate Sub mUserForm_Click()\n    Call HandleExitEvent\nEnd Sub\n\nPrivate Sub mFrame_Click()\n    Call HandleExitEvent\nEnd Sub\n\nPrivate Sub mLabel_Click()\n    Call HandleExitEvent\nEnd Sub\n\nPrivate Sub mCommandButton_Click()\n    Call HandleExitEvent\nEnd Sub\n\n' Event handlers for specific controls\nPrivate Sub mDropArrow_Click()\n    If Not IsControlActive(Me) Then Exit Sub\n    With Me\n        Select Case .ControlType\n            Case CONTROL_TYPE_COMBOBOX:\n                .ComboBox.DropDown\n                .DropArrow.Caption = .ChrDropArrowOn\n        End Select\n    End With\nEnd Sub\n\nPrivate Sub mBtnClear_Click()\n    Me.control.Value = vbNullString\nEnd Sub\n\nPrivate Sub mChkBoxBtn_Click()\n    Call UpdateSwitchState(Me.control.Value, True)\nEnd Sub\n\nPrivate Sub mTgBorder_Click()\n    Call UpdateSwitchState(Me.control.Value, True)\nEnd Sub\n\nPrivate Sub mCheckBox_Change()\n    Call UpdateSwitchState(Not Me.control.Value, False)\nEnd Sub\n\nPrivate Sub mChkBoxCaption_Click()\n    Call UpdateSwitchState(Me.control.Value, True)\nEnd Sub\n\nPrivate Sub mOptionButton_Change()\n    Call UpdateSwitchState(Not Me.control.Value, False)\nEnd Sub\n\n'================================================================================\n' Section: Internal helper methods\n'================================================================================\n'---------------------------------------------------------------------------------------\n' Procedure: UpdateSwitchState\n' Purpose: Internal method to update switch state\n' Parameters:\n'   Value - New switch value\n'   isChangeValue - Flag indicating whether to change control value\n'   isCheckBox - Flag indicating whether element is a checkbox\n'---------------------------------------------------------------------------------------\nPrivate Sub UpdateSwitchState(ByVal Value As Boolean, ByRef isChangeValue As Boolean)\n    With Me.control\n        If Not IsControlActive(Me) Then Exit Sub\n        If Value Then\n            If isChangeValue Then .Value = False\n            Call UpdateSwitchVisualState(False)\n        Else\n            If isChangeValue Then .Value = True\n            Call UpdateSwitchVisualState(True)\n        End If\n    End With\nEnd Sub\n\n'---------------------------------------------------------------------------------------\n' Procedure: UpdateSwitchVisualState\n' Purpose: Internal method to update switch visual state\n' Parameters:\n'   isEnabled - Flag indicating whether state is enabled\n'   isCheckBox - Flag indicating whether element is a checkbox\n'---------------------------------------------------------------------------------------\nPrivate Sub UpdateSwitchVisualState(ByVal isEnabled As Boolean)\n    ' Update position/symbol of element depending on type and state\n    With Me\n        Select Case .control.Tag\n            Case CONTROL_SWITCH:\n                ' Update for toggle switch\n                .ChkBoxBtn.left = .control.left + IIf(isEnabled, 17, 2)\n                If Not .TgBorder Is Nothing Then\n                    .TgBorder.Caption = VBA.ChrW(IIf(isEnabled, ToggleOn, ToggleOff))\n                End If\n            Case Else\n                ' Update for checkbox\n                If .ControlType = CONTROL_TYPE_CHECKBOX Then\n                    .ChkBoxBtn.Caption = IIf(isEnabled, .ChrChkBoxBtnOn, .ChrChkBoxBtnOff)\n                Else\n                    .ChkBoxBtn.Caption = IIf(isEnabled, .ChrOptBoxBtnOn, .ChrOptBoxBtnOff)\n                End If\n        End Select\n\n        ' Update colors\n        .ChkBoxBtn.ForeColor = IIf(isEnabled, .ColorChkBoxBtnOn, .ColorChkBoxBtnOff)\n        If Not .TgBorder Is Nothing Then\n            .TgBorder.ForeColor = IIf(isEnabled, .ColorTgBorderOn, .ColorTgBorderOff)\n        End If\n        If Not .ChkBoxCaption Is Nothing Then\n            .ChkBoxCaption.ForeColor = IIf(isEnabled, .ColorChkBoxCaptionOn, .ColorChkBoxCaptionOff)\n        End If\n    End With\nEnd Sub\n\n'---------------------------------------------------------------------------------------\n' Procedure: IsControlActive\n' Purpose: Helper method to check if control is active\n' Returns: True if element is visible, unlocked and available\n'---------------------------------------------------------------------------------------\nPrivate Function IsControlActive(ByRef itemStyle As clsModernStyle) As Boolean\n    With itemStyle\n        IsControlActive = .Visible And Not .Locked And .Enabled\n    End With\nEnd Function\n\n'---------------------------------------------------------------------------------------\n' Procedure: ConfigureStyleElement\n' Purpose: Internal method for configuring style element properties\n' Parameters:\n'   element - Style element to configure\n'   itemStyle - Style object\n'   width - Element width\n'   height - Element height\n'   left - Left position\n'   top - Top position\n'---------------------------------------------------------------------------------------\nPrivate Sub ConfigureStyleElement(ByRef element As MSForms.label, _\n        ByVal width As Single, ByVal height As Single, _\n        ByVal left As Single, ByVal top As Single)\n    With element\n        .width = width\n        .height = height\n        .left = left\n        .top = top\n    End With\nEnd Sub\n\n'---------------------------------------------------------------------------------------\n' Function: IsControlInCollection\n' Purpose: Check if control already exists in the collection\n' Parameters:\n'   controlName - Name of the control to check\n' Returns: True if control exists in collection, False otherwise\n'---------------------------------------------------------------------------------------\nPrivate Function IsControlInCollection(ByVal controlName As String) As Boolean\n    Dim tempItem    As clsModernStyle\n    Set tempItem = getItemByName(controlName)\n    If Not tempItem Is Nothing Then IsControlInCollection = True\nEnd Function\n\nPrivate Function IsControlInClass(ByVal controlName As String) As Boolean\n    If controlName Like \"*\" & BAR_BOTTOM Then\n        IsControlInClass = True\n    ElseIf controlName Like \"*\" & BAR_TITLE Then\n        IsControlInClass = True\n    ElseIf controlName Like \"*\" & BAR_ICON Then\n        IsControlInClass = True\n    ElseIf controlName Like \"*\" & BACK_GROUND Then\n        IsControlInClass = True\n    ElseIf controlName Like \"*\" & DROP_ARROW Then\n        IsControlInClass = True\n    ElseIf controlName Like \"*\" & BTN_CLEAR Then\n        IsControlInClass = True\n    ElseIf controlName Like \"*\" & SWITCH_BORDER Then\n        IsControlInClass = True\n    ElseIf controlName Like \"*\" & SWITCH_CAPTION Then\n        IsControlInClass = True\n    ElseIf controlName Like \"*\" & SWITCH_THUMB Then\n        IsControlInClass = True\n    End If\nEnd Function\n\n'---------------------------------------------------------------------------------------\n' Procedure: Class_Terminate\n' Purpose: Clean up objects when class is terminated\n'---------------------------------------------------------------------------------------\nPrivate Sub Class_Terminate()\n    ' Clean up event handler objects\n    Set mUserForm = Nothing\n    Set mTextBox = Nothing\n    Set mComboBox = Nothing\n    Set mListBox = Nothing\n    Set mFrame = Nothing\n    Set mLabel = Nothing\n    Set mCommandButton = Nothing\n    Set mCheckBox = Nothing\n    Set mOptionButton = Nothing\n\n    ' Clean up style elements\n    Set mStyleItems = Nothing\n    Set mControl = Nothing\n    Set mBarBottom = Nothing\n    Set mBarTitle = Nothing\n    Set mBarIcon = Nothing\n    Set mBackGround = Nothing\n    Set mDropArrow = Nothing\n    Set mBtnClear = Nothing\n    Set mTgBorder = Nothing\n    Set mChkBoxBtn = Nothing\n    Set mChkBoxCaption = Nothing\nEnd Sub\n", 
      "CODE": "    Dim MStyleItem      As clsModernStyle\r\n    Set MStyleItem = New clsModernStyle\r\n    Call MStyleItem.Initialize(Me)", 
      "DISCRIPTION": "Создание нового стиля для User Forms"
    }, 
    {
      "CODE_GRUP": "Forms", 
      "CODE_SNIPPET": "clsProgresBar", 
      "clsProgresBar.cls": "'\nPrivate frmForma    As frmProgresBar_2\n\nPrivate mWidth      As Single\nPrivate mHeightMessage As Single\n\nProperty Get Forma() As frmProgresBar_2\n    If frmForma Is Nothing Then\n        Set Forma = New frmProgresBar_2\n    Else\n        Set Forma = frmForma\n    End If\nEnd Property\n\nProperty Get Header() As String\n    Header = frmForma.Caption\nEnd Property\n\nPublic Property Let Header(ByRef sHeader As String)\n    frmForma.Caption = sHeader\nEnd Property\n\nProperty Get MessageTop() As String\n    MessageTop = frmForma.Message.Caption\nEnd Property\n\nPublic Property Let MessageTop(ByRef sMessage As String)\n    frmForma.Message.Caption = sMessage\nEnd Property\n\nProperty Get MessageBottom() As String\n    MessageBottom = frmForma.MessageTwo\nEnd Property\n\nPublic Property Let MessageBottom(ByRef sMessage As String)\n    frmForma.MessageTwo.Caption = sMessage\nEnd Property\n\nProperty Get ShowPict() As Boolean\n    ShowPict = frmForma.lbPict.Visible\nEnd Property\n\nPublic Property Let ShowPict(ByRef Show As Boolean)\n    frmForma.lbPict.Visible = Show\nEnd Property\n\nProperty Get sPict() As String\n    sPict = frmForma.lbPict.Caption\nEnd Property\n\nPublic Property Let sPict(ByRef sPict As String)\n    frmForma.lbPict.Caption = sPict\nEnd Property\n\nProperty Get lPictColor() As Long\n    lPictColor = frmForma.lbPict.ForeColor\nEnd Property\n\nPublic Property Let lPictColor(ByRef lColor As Long)\n    frmForma.lbPict.ForeColor = lColor\nEnd Property\n\nProperty Get lProgressColor() As Long\n    lProgressColor = frmForma.lbLine.BackColor\nEnd Property\n\nPublic Property Let lProgressColor(ByRef lColor As Long)\n    frmForma.lbLine.BackColor = lColor\nEnd Property\n\nPublic Sub Initialize(ByRef sMessage As String, ByRef sHeader As String, Optional bShowPict As Boolean = False, Optional sPict As String = vbNullString)\n    Set frmForma = Forma()\n    With frmForma\n        .Caption = sHeader\n        .Message = sMessage\n        .MessageTwo = vbNullString\n        .ProgressPercent.Caption = \"0%\"\n        .lbLine.Width = 0\n        .lbLine.Caption = VBA.String$(300, \"|\")\n        With .lbPict\n            .Caption = sPict\n            .Left = 0\n            .Visible = bShowPict\n        End With\n        .StartUpPosition = 0\n        .Left = Application.Left + 0.5 * (Application.Width - .Width)\n        .Top = Application.Top + 0.5 * (Application.Height - .Height)\n        mWidth = .Width\n        mHeightMessage = .Message.Height\n        Call .Show(0)\n    End With\nEnd Sub\n\nPublic Sub Resize(ByVal Width As Double, ByVal HeightMessage As Double, ByVal HeightMessageTwo As Double)\n    With frmForma\n        Dim dbDelta As Double\n        dbDelta = Width - .Width\n        If Width > mWidth Then\n            .MessageTwo.Width = dbDelta + .MessageTwo.Width\n            .Message.Width = dbDelta + .Message.Width\n            .lbLineTwo.Width = dbDelta + .lbLineTwo.Width\n            .ProgressPercent.Left = .lbLineTwo.Left + .lbLineTwo.Width\n            .Width = Width\n        End If\n\n        dbDelta = HeightMessage - .Message.Height\n        If .Height + dbDelta > 0 And .Message.Height + dbDelta > 0 Then\n            .Height = .Height + dbDelta\n            .Message.Height = .Message.Height + dbDelta\n\n            .MessageTwo.Top = .MessageTwo.Top + dbDelta\n            .ProgressPercent.Top = .ProgressPercent.Top + dbDelta\n            .lbLine.Top = .lbLine.Top + dbDelta\n            .lbLineTwo.Top = .lbLineTwo.Top + dbDelta\n            .lbPict.Top = .lbPict.Top + dbDelta\n        End If\n\n        dbDelta = HeightMessageTwo - .MessageTwo.Height\n        If .Height + dbDelta > 0 And .MessageTwo.Height + dbDelta > 0 Then\n            .Height = .Height + dbDelta\n            .MessageTwo.Height = .MessageTwo.Height + dbDelta\n\n            .ProgressPercent.Top = .ProgressPercent.Top + dbDelta\n            .lbLine.Top = .lbLine.Top + dbDelta\n            .lbLineTwo.Top = .lbLineTwo.Top + dbDelta\n            .lbPict.Top = .lbPict.Top + dbDelta\n        End If\n\n        .StartUpPosition = 0\n        .Left = Application.Left + (0.5 * Application.Width) - (0.5 * .Width)\n        .Top = Application.Top + (0.5 * Application.Height) - (0.5 * .Height)\n        .Repaint\n    End With\nEnd Sub\n\nPublic Sub Update(ByVal i As Long, ByVal iCount As Long, ByVal sMsg As String)\n    Dim dol         As Double\n    dol = i / iCount\n    With frmForma\n        .MessageTwo.Caption = sMsg\n        If dol <= 1 Then\n            .ProgressPercent.Caption = VBA.Format$(dol, \"0%\")\n            .lbLine.Width = .lbLineTwo.Width * dol\n            If .lbPict.Visible Then .lbPict.Left = .lbLine.Left + .lbLine.Width - 5\n        End If\n        .Repaint\n        DoEvents\n    End With\nEnd Sub\n\nPrivate Sub Class_Terminate()\n    frmForma.Hide\n    Set frmForma = Nothing\nEnd Sub", 
      "CODE": "    Dim oProg       As clsProgresBar\r\n    Set oProg = New clsProgresBar\r\n    Call oProg.Initialize(sMessage:=\"text msg\", sHeader:=\"text_header\", bShowPict:=True, sPict:=\"o\")", 
      "DISCRIPTION": "Создание класса прогресс бара", 
      "frmProgresBar_2.frm": "VERSION 5.00\n\nBegin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} frmProgresBar_2 \n\n   Caption         =   \"UserForm1\"\n\n   ClientHeight    =   2145\n\n   ClientLeft      =   120\n\n   ClientTop       =   465\n\n   ClientWidth     =   11970\n\n   OleObjectBlob   =   \"frmProgresBar_2.frx\":0000\n\n   StartUpPosition =   1  'CenterOwner\n\nEnd\n\nAttribute VB_Name = \"frmProgresBar_2\"\n\nAttribute VB_GlobalNameSpace = False\n\nAttribute VB_Creatable = False\n\nAttribute VB_PredeclaredId = True\n\nAttribute VB_Exposed = False\n\nOption Explicit\n\n\n\nPrivate Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)\n\n    If CloseMode = 0 Then Cancel = 1\n\nEnd Sub\n\n", 
      "frmProgresBar_2.frx": "TEIIAAAMAAAAAAAAAAAAALIvAACqCgAA0M8R4KGxGuEAAAAAAAAAAAAAAAAAAAAAPgADAP7/\nCQAGAAAAAAAAAAAAAAABAAAAAQAAAAAAAAAAEAAAAgAAAAEAAAD+////AAAAAAAAAAD/////\n////////////////////////////////////////////////////////////////////////\n////////////////////////////////////////////////////////////////////////\n////////////////////////////////////////////////////////////////////////\n////////////////////////////////////////////////////////////////////////\n////////////////////////////////////////////////////////////////////////\n////////////////////////////////////////////////////////////////////////\n////////////////////////////////////////////////////////////////////////\n///////////////////////////////////////////////////////////////////9////\n/v////7///8EAAAA/v//////////////////////////////////////////////////////\n////////////////////////////////////////////////////////////////////////\n////////////////////////////////////////////////////////////////////////\n////////////////////////////////////////////////////////////////////////\n////////////////////////////////////////////////////////////////////////\n////////////////////////////////////////////////////////////////////////\n////////////////////////////////////////////////////////////////////////\n////////////////////////////////////////////////////////////////////////\n////////////////////////////////////////////////////////////////////////\n/////////////////////////////1IAbwBvAHQAIABFAG4AdAByAHkAAAAAAAAAAAAAAAAA\nAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAWAAUA//////////8CAAAA8GkqxtwW\nzhGemACqAFdKTwAAAAAAAAAAAAAAAOBQEoksAdwBAwAAAMADAAAAAAAAZgAAAAAAAAAAAAAA\nAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAQA\nAgD///////////////8AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA\ngwEAAAAAAABvAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA\nAAAAAAAAAAAAAAAAAAAAAAAABAACAQEAAAADAAAA/////wAAAAAAAAAAAAAAAAAAAAAAAAAA\nAAAAAAAAAAAAAAAAAAAAAAIAAABUAQAAAAAAAAEAQwBvAG0AcABPAGIAagAAAAAAAAAAAAAA\nAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAASAAIA////////////////\nAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAADQAAAG4AAAAAAAAAAQAAAAgA\nAAADAAAABAAAAAUAAAAGAAAABwAAAP7///8JAAAACgAAAAsAAAAMAAAA/v///w4AAAD+////\n////////////////////////////////////////////////////////////////////////\n////////////////////////////////////////////////////////////////////////\n////////////////////////////////////////////////////////////////////////\n////////////////////////////////////////////////////////////////////////\n////////////////////////////////////////////////////////////////////////\n////////////////////////////////////////////////////////////////////////\n////////////////////////////////////////////////////////////////////////\n////////////////////////////////////////////////////////////////////////\n//////////////////////////8ABCgASAwQDAcAAAAEQAAA//8AAAwAAAAAfQAAelIAAMgO\nAAAAAAAAAAAAAANS4wuRj84RneMAqgBLuFEBzAAAkAFEQgEABlRhaG9tYQAABgAAABwBAAAA\nhgF2AAAwAPUBAAAPAACAAwAAADIAAAA8AAAAAQAVAFByb2dyZXNzUAACFAAoAAAABAAAgDEw\nMCXIBgAACAMAAAACIAD3AAAABgAAgAEAAEAdAQAAzAICALwCAABUYWhvbWEAAAACEAAgAQAA\nAQAAAGpKAAAIAwAAAAIYADUAAAAGAACApQAAAMwCAABUYWhvbWEAAAACGAAjAQAAAEAAAMD/\nwAABAAAApwEAAAgDAAAAAhwAtwAAAAYAAIABAABAHQEAAMwCvAJUYWhvbWEAAAACFAAoAAAA\nBAAAgFRleHQHUQAAnQYAAAACGAA1AAAABgAAgDsBAAAAAgAAVGFob21hAAAAAhgAKAEAAAQA\nAIABAAAAVGV4dAdRAABPAwAAAAIYADUAAAAGAACA8AAAAAACAABUYWhvbWEAAAACHAAtAAAA\nAIAAABMAAAABAACAb9ZTKCIEAABBAwAAAAIcALcAAAAIAACAAQAAQCsCAAACArwCV2ViZGlu\nZ3MAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAGVyY2VudABM\nSwAAaQsAAAAALAD1AQAACQAAgAQAAAAyAAAAMAAAAAIAFQBsYkxpbmVUd2+2vCrUAAAAaQsA\nAAAAKAD1AQAABgAAgAIAAAAyAAAAPAAAAAAAFQBsYkxpbmUAANQAAABpCwAAAAAoAPUBAAAH\nAACABQAAADIAAAA0AAAAAwAVAE1lc3NhZ2UA1AAAANQAAAAAACwA9QEAAAoAAIAGAAAAMgAA\nADgAAAAEABUATWVzc2FnZVR3b3QA1AAAAHEHAAAAACgA9QEAAAYAAIAHAAAAMgAAAEAAAAAF\nABUAbGJQaWN0AADUAAAARQgAAAACDAAZAAAA838BAP8BAAAAAAAAAAAAAAAAAAAAAAAAAAAA\nAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAQD+/wMKAAD/////\n8GkqxtwWzhGemACqAFdKTxkAAABNaWNyb3NvZnQgRm9ybXMgMi4wIEZvcm0AEAAAAEVtYmVk\nZGVkIE9iamVjdAANAAAARm9ybXMuRm9ybS4xAPQ5snEAAAAAAAAAAAAAAAAAAAAAAAAAAAAA\nAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA\nAAAAAAAAAAAAAAAAAAAAAAAAAAAA"
    }, 
    {
      "CODE_GRUP": "Forms", 
      "CODE_SNIPPET": "clsSlider", 
      "clsSlider.cls": "'\n''========================================================================================\n' Class: clsSlider\n' Author: VBATools\n' Version: 1.0.3\n' Creation Date: 13.11.2025 10:59\n' Last Update Date: 29.11.2025 14:00\n' License: Apache License\n'\n' Description:\n'    This class implements a custom slider control for VBA UserForms. The slider allows\n'    users to select a value within a specified range by dragging a button along a track.\n'    It supports both horizontal and vertical orientations and provides customizable\n'    appearance and behavior options.\n'\n' Features:\n'    - Horizontal and vertical orientation support\n'    - Configurable min/max values and initial value\n'    - Customizable appearance (colors, icons, formatting)\n'    - Visible/hidden value label with positioning options\n'    - Event handling for value changes and clicks\n'    - Lock functionality to prevent user interaction\n'    - Automatic positioning of value label (top, left, right, bottom)\n'\n' Usage:\n'    1. Create an instance of clsSlider\n'    2. Call Initialize method with appropriate parameters\n'    3. Handle Change and Click events as needed\n'    4. Access Value property to get/set current value\n'\n' Dependencies:\n'    - MSForms library for Label controls\n'    - XlRgbColor constants for color properties\n'\n'========================================================================================\n\nPublic Enum PositionValue\n    Top = 1  ' Position of the value label above the slider\n    Left   ' Position of the value label to the left of the slider\n    Right    ' Position of the value label to the right of the slider\n    Bottom    ' Position of the value label below the slider\nEnd Enum\n\nPrivate WithEvents mTxtBtn As MSForms.TextBox\nPrivate WithEvents mParent As MSForms.UserForm\nPrivate mLabelLineEmpty As MSForms.Label\nPrivate mLabelLineFull As MSForms.Label\nPrivate mLabelValue As MSForms.Label\n\nPublic Event DblClick(ByRef control As Object, ByRef Value As Single)\nPublic Event Change(ByRef control As Object, ByRef Value As Single)\n\nPrivate mNameLabel As String        ' Name of the main slider label\nPrivate mFormatValue As String      ' Format for displaying the value\nPrivate mValue As Single            ' Current slider value\nPrivate mMaxValue As Single         ' Maximum slider value\nPrivate mMinValue As Single         ' Minimum slider value\nPrivate mSliderMinPosition As Single    ' Minimum slider position\nPrivate mSliderMaxPosition As Single    ' Maximum slider position\nPrivate mIsHorizontal As Boolean    ' Flag for horizontal orientation\nPrivate mLocked As Boolean          ' Flag for locking the slider\nPrivate mPositionValue As PositionValue  ' Position of the value label\nPrivate mButtonColor As XlRgbColor\nPrivate mStep As Single\n\nPublic Property Get Version() As String\n    ' Returns version information about the class\n    ' Example: Debug.Print slider.Version\n    Version = \"Class: clsSlider\" & vbNewLine & _\n            \"Author: VBATools\" & vbNewLine & _\n            \"Version: 1.0.3\" & vbNewLine & _\n            \"Date of creation: 13.11.2025 10:59\" & vbNewLine & _\n            \"Date of update: 29.11.2025 14:00\" & vbNewLine & _\n            \"License: Apache\" & vbNewLine & _\n            \"Description: Custom slider control for VBA UserForms with horizontal/vertical orientation support\"\nEnd Property\n\nPublic Property Get StepSlider() As Single\n    StepSlider = mStep\nEnd Property\n\nPublic Property Let StepSlider(ByVal Value As Single)\n\n    If Value = 0 Or (mMaxValue - mMinValue) < Value Then\n        mStep = (mMaxValue - mMinValue) / mLabelLineEmpty.Width\n    Else\n        mStep = Value\n    End If\nEnd Property\n\nPublic Property Get Locked() As Boolean\n    ' Returns the lock state of the slider\n    ' If True, the slider does not respond to user actions\n    ' Example: If slider.Locked Then Debug.Print \"Slider is locked\"\n    Locked = mLocked\nEnd Property\n\nPublic Property Let Locked(ByVal Value As Boolean)\n    ' Sets the lock state of the slider\n    ' When True, the slider does not respond to user actions\n    ' Example: slider.Locked = True\n    mLocked = Value\nEnd Property\n\nPublic Property Get Enabled() As Boolean\n    ' Returns the enabled state of the slider\n    ' If False, the slider appears grayed out and does not respond to user actions\n    ' Example: If slider.Enabled Then Debug.Print \"Slider is enabled\"\n    Enabled = mTxtBtn.Enabled\nEnd Property\n\nPublic Property Let Enabled(ByVal Value As Boolean)\n    ' Sets the enabled state of the slider\n    ' When False, the slider appears grayed out and does not respond to user actions\n    ' Example: slider.Enabled = False\n    mTxtBtn.Enabled = Value\n    mLabelValue.Enabled = Value\nEnd Property\n\nPublic Property Get Visible() As Boolean\n    ' Returns the visibility state of all slider elements\n    ' If False, all slider elements are hidden\n    ' Example: If slider.Visible Then Debug.Print \"Slider is visible\"\n    Visible = mTxtBtn.Visible\nEnd Property\n\nPublic Property Let Visible(ByVal Value As Boolean)\n    ' Sets the visibility state of all slider elements\n    ' When False, all slider elements are hidden\n    ' Example: slider.Visible = False\n    mTxtBtn.Visible = Value\n    mLabelLineEmpty.Visible = Value\n    mLabelLineFull.Visible = Value\n    mLabelValue.Visible = Value\nEnd Property\n\nPublic Property Get VisibleLabelValue() As Boolean\n    ' Returns the visibility state of the slider value label\n    ' If False, the value label is not displayed\n    ' Example: If slider.VisibleLabelValue Then Debug.Print \"Value label is visible\"\n    VisibleLabelValue = mLabelValue.Visible\nEnd Property\n\nPublic Property Let VisibleLabelValue(ByVal Value As Boolean)\n    ' Sets the visibility state of the slider value label\n    ' When False, the value label is hidden\n    ' Example: slider.VisibleLabelValue = False\n    mLabelValue.Visible = Value\nEnd Property\n\nPublic Property Get Icon() As Long\n    ' Returns the icon on the slider button (as a Unicode character value)\n    ' Example: Dim currentIcon As Long: currentIcon = slider.Icon\n    Icon = VBA.CLng(mTxtBtn.Caption)\nEnd Property\n\nPublic Property Let Icon(ByVal Value As Long)\n    ' Sets the icon on the slider button\n    ' Accepts a Unicode character value\n    ' Example: slider.Icon = 59963  (sets an icon from Segoe MDL2 Assets font)\n    mTxtBtn.Value = VBA.ChrW(Value)\nEnd Property\n\nPublic Property Get PositionLabelValue() As PositionValue\n    ' Returns the current position of the slider value label\n    ' Possible values: Top, Left, Right, Bottom\n    ' Example: Dim pos As PositionValue: pos = slider.PositionLabelValue\n    PositionLabelValue = mPositionValue\nEnd Property\n\nPublic Property Let PositionLabelValue(ByVal Value As PositionValue)\n    ' Sets the position of the slider value label\n    ' Accepts a value from the PositionValue enumeration (Top, Left, Right, Bottom)\n    ' Example: slider.PositionLabelValue = clsSlider.PositionValue.Right\n    mPositionValue = Value\n    Call UpdateValueLabelPosition(mPositionValue)\nEnd Property\n\nPublic Property Get FormatValue() As String\n    ' Returns the format for displaying the slider value\n    ' Used to format the numeric value when displayed\n    ' Example: Dim fmt As String: fmt = slider.FormatValue\n    FormatValue = mFormatValue\nEnd Property\n\nPublic Property Let FormatValue(ByVal Value As String)\n    ' Sets the format for displaying the slider value\n    ' Accepts a format string similar to that used in the Format function\n    ' Example: slider.FormatValue = \"0.00%\"  (displays value as percentage)\n    mFormatValue = Value\n    If mFormatValue <> vbNullString Then\n        mLabelValue.Caption = VBA.Format$(getValue(), mFormatValue)\n    Else\n        mLabelValue.Caption = getValue()\n    End If\nEnd Property\n\nPublic Property Get ForeColorValue() As XlRgbColor\n    ' Returns the text color of the slider value label\n    ' Example: Dim color As XlRgbColor: color = slider.ForeColorValue\n    ForeColorValue = mLabelValue.ForeColor\nEnd Property\n\nPublic Property Let ForeColorValue(ByVal Value As XlRgbColor)\n    ' Sets the text color of the slider value label\n    ' Example: slider.ForeColorValue = rgbRed\n    mLabelValue.ForeColor = Value\nEnd Property\n\nPublic Property Get ForeColorBtn() As XlRgbColor\n    ' Returns the text color of the slider button\n    ' Example: Dim color As XlRgbColor: color = slider.ForeColorBtn\n    ForeColorBtn = mTxtBtn.ForeColor\nEnd Property\n\nPublic Property Let ForeColorBtn(ByVal Value As XlRgbColor)\n    ' Sets the text color of the slider button\n    ' Example: slider.ForeColorBtn = rgbBlue\n    mTxtBtn.ForeColor = Value\n    mButtonColor = Value\nEnd Property\n\nPublic Property Get BackColorFull() As XlRgbColor\n    ' Returns the color of the filled part of the slider line\n    ' Example: Dim color As XlRgbColor: color = slider.BackColorFull\n    BackColorFull = mLabelLineFull.BackColor\nEnd Property\n\nPublic Property Let BackColorFull(ByVal Value As XlRgbColor)\n    ' Sets the color of the filled part of the slider line\n    ' Example: slider.BackColorFull = rgbGreen\n    mLabelLineFull.BackColor = Value\nEnd Property\n\nPublic Property Get BackColorEmpty() As XlRgbColor\n    ' Returns the color of the empty part of the slider line\n    ' Example: Dim color As XlRgbColor: color = slider.BackColorEmpty\n    BackColorEmpty = mLabelLineEmpty.BackColor\nEnd Property\n\nPublic Property Let BackColorEmpty(ByVal Value As XlRgbColor)\n    ' Sets the color of the empty part of the slider line\n    ' Example: slider.BackColorEmpty = rgbGray\n    mLabelLineEmpty.BackColor = Value\nEnd Property\n\nPublic Property Get Name() As String\n    ' Returns the name of the main slider label\n    ' Example: Dim sliderName As String: sliderName = slider.Name\n    Name = mNameLabel\nEnd Property\n\nPublic Property Get IsHorizontal() As Boolean\n    ' Returns whether the slider is horizontal\n    ' True - horizontal, False - vertical\n    ' Example: If slider.IsHorizontal Then Debug.Print \"Slider is horizontal\"\n    IsHorizontal = mIsHorizontal\nEnd Property\n\nPublic Property Get MinValue() As Single\n    ' Returns the minimum value of the slider\n    ' Example: Dim minVal As Single: minVal = slider.MinValue\n    MinValue = mMinValue\nEnd Property\n\nPublic Property Let MinValue(ByVal Value As Single)\n    ' Sets the minimum value of the slider\n    ' Example: slider.MinValue = 0\n    mMinValue = Value\nEnd Property\n\nPublic Property Get MaxValue() As Single\n    ' Returns the maximum value of the slider\n    ' Example: Dim maxVal As Single: maxVal = slider.MaxValue\n    MaxValue = mMaxValue\nEnd Property\n\nPublic Property Let MaxValue(ByVal Value As Single)\n    ' Sets the maximum value of the slider\n    ' Example: slider.MaxValue = 100\n    mMaxValue = Value\nEnd Property\n\nPublic Property Get Value() As Single\n    ' Returns the current value of the slider\n    ' Example: Dim currentVal As Single: currentVal = slider.Value\n    Value = mValue\nEnd Property\n\nPublic Property Let Value(ByVal Value As Single)\n    ' Sets the current value of the slider\n    ' The value must be within the range from MinValue to MaxValue\n    ' Example: slider.Value = 50\n    Select Case Value\n        Case mMinValue To mMaxValue:\n            Call SetValue(Value)\n    End Select\nEnd Property\n\nPublic Sub Initialize(ByRef labelSlider As MSForms.Label, _\n        ByVal Value As Single, _\n        ByVal MinValue As Single, _\n        ByVal MaxValue As Single, _\n        ByVal VisibleLabelValue As Boolean, _\n        Optional StepSlider As Single = 0, _\n        Optional FormatValue As String = vbNullString, _\n        Optional PositionValue As PositionValue = Top, _\n        Optional BackColorEmpty As XlRgbColor = rgbLightGray, _\n        Optional BackColorFull As XlRgbColor = rgbGreenYellow, _\n        Optional ForeColorBtn As XlRgbColor = rgbBlack, _\n        Optional ForeColorValue As XlRgbColor = rgbBlack, _\n        Optional Icon As Long = 59963)\n    ' Initializes the slider with specified parameters\n    ' Parameters:\n    ' - labelSlider: the main label that will be used as the empty slider line\n    ' - Value: initial value of the slider\n    ' - MinValue: minimum value of the slider\n    ' - MaxValue: maximum value of the slider\n    ' - VisibleLabelValue: visibility of the value label\n    ' - FormatValue: format for displaying the value (default vbNullString)\n    ' - PositionValue: position of the value label (default Top)\n    ' - BackColorEmpty: color of the empty part of the line (default rgbLightGray)\n    ' - BackColorFull: color of the filled part of the line (default rgbGreenYellow)\n    ' - ForeColorBtn: color of the button (default rgbBlack)\n    ' - ForeColorValue: color of the value (default rgbBlack)\n    ' - Icon: icon on the button (default 59963)\n    '\n    ' Usage example:\n    ' Dim slider As New clsSlider\n    ' Call slider.Initialize(Me.Label1, 50, 0, 100, True, \"0.0\", clsSlider.PositionValue.Top)\n    '\n    ' Check if the value range is valid\n    If MinValue >= MaxValue Then\n        Err.Raise vbObjectError + 1001, \"clsSlider\", \"Minimum value must be less than maximum value\"\n    End If\n\n    ' Check if the initial value is within the range\n    If Value < MinValue Or Value > MaxValue Then\n        Err.Raise vbObjectError + 1002, \"clsSlider\", \"Initial value must be within the MinValue..MaxValue range\"\n    End If\n\n    Set mLabelLineEmpty = labelSlider\n    Set mParent = mLabelLineEmpty.Parent\n    mValue = Value\n    mMaxValue = MaxValue\n    mMinValue = MinValue\n    mFormatValue = FormatValue\n    mPositionValue = PositionValue\n    mButtonColor = ForeColorBtn\n\n    If StepSlider = 0 Or (mMaxValue - mMinValue) < StepSlider Then\n            mStep = (mMaxValue - mMinValue) / mLabelLineEmpty.Width\n        Else\n            mStep = StepSlider\n        End If\n\n    With mLabelLineEmpty\n        mIsHorizontal = .Width / .Height > 1\n        If mIsHorizontal Then\n            .Height = 3\n            mSliderMinPosition = .Left\n            mSliderMaxPosition = mSliderMinPosition + .Width\n        Else\n            .Width = 3\n            mSliderMinPosition = .Top\n            mSliderMaxPosition = mSliderMinPosition + .Height\n        End If\n        .Caption = vbNullString\n        mNameLabel = .Name\n        .BackColor = BackColorEmpty\n        Set mLabelLineFull = mLabelLineEmpty.Parent.Controls.Add(\"Forms.label.1\", mNameLabel & \"_full\", True)\n        Set mTxtBtn = mLabelLineEmpty.Parent.Controls.Add(\"Forms.TextBox.1\", mNameLabel & \"_btn\", True)\n        Set mLabelValue = mLabelLineEmpty.Parent.Controls.Add(\"Forms.label.1\", mNameLabel & \"_value\", True)\n    End With\n\n    With mLabelLineFull\n        .Caption = vbNullString\n        .Top = mLabelLineEmpty.Top\n        .Left = mLabelLineEmpty.Left\n        .BackColor = BackColorFull\n        .ZOrder 0\n    End With\n\n    With mTxtBtn\n        .Height = 20\n        .Width = .Height\n        .BackStyle = fmBackStyleTransparent\n        .TextAlign = fmTextAlignCenter\n        .Font.Name = \"Segoe MDL2 Assets\"\n        .Font.Size = 10\n        .Value = VBA.ChrW(Icon)\n        .Locked = True\n        .SpecialEffect = fmSpecialEffectFlat\n        '.BorderStyle = fmBorderStyleSingle\n        .ForeColor = ForeColorBtn\n        .MousePointer = fmMousePointerArrow\n        .ZOrder 0\n    End With\n\n    With mLabelValue\n        .Visible = VisibleLabelValue\n        .BackStyle = fmBackStyleTransparent\n        .Font.Name = mLabelLineEmpty.Font.Name\n        .Font.Size = mLabelLineEmpty.Font.Size\n        .TextAlign = fmTextAlignCenter\n        .ForeColor = ForeColorValue\n        .ZOrder 0\n    End With\n    Call SetValue(mValue)\nEnd Sub\n\nPrivate Sub mTxtBtn_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal shift As Integer)\n    Dim sShift      As Double\n    If mIsHorizontal Then\n        Select Case KeyCode\n            Case 37, 65\n                Call ApplyHoverEffect(100)\n                sShift = mValue - mStep\n                If sShift < mMinValue Then sShift = mMinValue\n                Me.Value = sShift\n            Case 39, 68\n                Call ApplyHoverEffect(100)\n                sShift = mValue + mStep\n                If sShift > mMaxValue Then sShift = mMaxValue\n                Me.Value = sShift\n        End Select\n    Else\n        Select Case KeyCode\n            Case 38, 87\n                Call ApplyHoverEffect(100)\n                KeyCode = 87\n                sShift = mValue - mStep\n                If sShift < mMinValue Then sShift = mMinValue\n                Me.Value = sShift\n            Case 40, 83\n                Call ApplyHoverEffect(100)\n                KeyCode = 83\n                sShift = mValue + mStep\n                If sShift > mMaxValue Then sShift = mMaxValue\n                Me.Value = sShift\n        End Select\n    End If\n    mTxtBtn.SetFocus\n    RaiseEvent Change(mTxtBtn, mValue)\nEnd Sub\n\n' DblClick event handler for the slider button\n' Event handler for the slider button click\n' Raises the DblClick event, passing a reference to the control and the current value\n' Example usage in a form:\n' Private Sub slider_DblClick(control As Object, Value As Single)\n'     Debug.Print \"DblClick on control: \" & control.Name & \", value: \" & Value\n' End Sub\nPrivate Sub mTxtBtn_DblClick(ByVal Cancel As MSForms.ReturnBoolean)\n    If mLocked Then Exit Sub\n    Cancel = True\n    RaiseEvent DblClick(mTxtBtn, mValue)\nEnd Sub\n\n' MouseUp event handler for the slider\n' Event handler for releasing the mouse button on the slider\n' Updates the button position after dragging is completed\n' Example usage: updating button position when mouse is released\nPrivate Sub mTxtBtn_MouseUp(ByVal Button As Integer, ByVal shift As Integer, ByVal X As Single, ByVal Y As Single)\n    If Button <> 1 Or mLocked Then Exit Sub\n    With mTxtBtn\n        If mIsHorizontal Then\n            .Left = mLabelLineFull.Left + mLabelLineFull.Width - .Width / 2\n        Else\n            .Top = mLabelLineFull.Top + mLabelLineFull.Height - .Height / 2\n        End If\n    End With\nEnd Sub\n\nPrivate Sub mParent_MouseMove(ByVal Button As Integer, ByVal shift As Integer, ByVal X As Single, ByVal Y As Single)\n    Call ApplyHoverEffect(0)\nEnd Sub\n\n' MouseMove event handler for the slider\n' Event handler for mouse movement on the slider\n' Updates the button position and slider value during dragging\n' Raises the Change event when the value changes\n' Example usage in a form:\n' Private Sub slider_Change(control As Object, Value As Single)\n'     Debug.Print \"Value changed: \" & Value\n' End Sub\nPrivate Sub mTxtBtn_MouseMove(ByVal Button As Integer, ByVal shift As Integer, ByVal X As Single, ByVal Y As Single)\n    Call ApplyHoverEffect(100)\n    If Button <> 1 Or mLocked Then Exit Sub\n    With mTxtBtn\n        If mIsHorizontal Then\n            Select Case .Left + X\n                Case mSliderMinPosition To mSliderMaxPosition - 5:\n                    .Left = .Left + X\n                    Select Case mTxtBtn.Left + X\n                        Case Is < mSliderMinPosition\n                            mLabelLineFull.Width = 0\n                        Case Is > mSliderMaxPosition\n                            mLabelLineFull.Width = mLabelLineEmpty.Width\n                        Case Else\n                            If mLabelLineFull.Width + X < 0 Then\n                                mLabelLineFull.Width = 0\n                            Else\n                                mLabelLineFull.Width = mLabelLineFull.Width + X\n                            End If\n                    End Select\n            End Select\n        Else\n            Select Case .Top + Y\n                Case mSliderMinPosition To mSliderMaxPosition - 5:\n                    .Top = .Top + Y\n                    Select Case mTxtBtn.Top + Y\n                        Case Is < mSliderMinPosition\n                            mLabelLineFull.Height = 0\n                        Case Is > mSliderMaxPosition\n                            mLabelLineFull.Height = mLabelLineEmpty.Height\n                        Case Else\n                            If mLabelLineFull.Height + Y < 0 Then\n                                mLabelLineFull.Height = 0\n                            Else\n                                mLabelLineFull.Height = mLabelLineFull.Height + Y\n                            End If\n                    End Select\n            End Select\n        End If\n    End With\n    If mFormatValue = vbNullString Then\n        mLabelValue.Caption = getValue()\n    Else\n        mLabelValue.Caption = VBA.Format$(getValue(), mFormatValue)\n    End If\n    RaiseEvent Change(mTxtBtn, mValue)\nEnd Sub\n\n' Applies a hover effect to the slider button by adjusting its color\n' The shade parameter determines the intensity of the effect (0-255)\nPrivate Sub ApplyHoverEffect(ByVal shade As Byte)\n    mTxtBtn.ForeColor = BlendColor(mButtonColor, RGB(255, 255, 255), shade / 255)\nEnd Sub\n\n' Function to blend two colors based on a factor\n' This function is used to create the hover effect on the slider button\n' Parameters:\n' - color1: the base color to start from\n' - color2: the target color to blend towards\n' - factor: the blending factor (0.0 to 1.0), where 0.0 is color1 and 1.0 is color2\nPrivate Function BlendColor(ByVal color1 As Long, color2 As Long, factor As Double) As Long\n    Dim r1 As Byte, g1 As Byte, b1 As Byte\n    Dim r2 As Byte, g2 As Byte, b2 As Byte\n    Dim r As Byte, g As Byte, b As Byte\n    \n    ' Extract RGB components from the first color (VBA uses BGR format)\n    r1 = color1 Mod 256\n    g1 = (color1 \\ 256) Mod 256\n    b1 = (color1 \\ 65536) Mod 256\n    \n    ' Extract RGB components from the second color (VBA uses BGR format)\n    r2 = color2 Mod 256\n    g2 = (color2 \\ 256) Mod 256\n    b2 = (color2 \\ 65536) Mod 256\n    \n    ' Blend the colors\n    r = r1 + (r2 - r1) * factor\n    g = g1 + (g2 - g1) * factor\n    b = b1 + (b2 - b1) * factor\n    \n    ' Return the blended color\n    BlendColor = RGB(r, g, b)\nEnd Function\n\n' Calculates the current slider value based on the slider position and value range\n' Calculates the current slider value based on the position of the thumb and value range\n' Returns a value in the range from MinValue to MaxValue\n' Example usage: Dim currentValue As Single: currentValue = slider.getValue()\nPrivate Function getValue() As Single\n    ' Check for division by zero\n    If mLabelLineEmpty.Width = 0 Or mLabelLineEmpty.Height = 0 Then\n        getValue = mMinValue\n        mValue = getValue\n        Exit Function\n    End If\n\n    Dim positionRatio As Double\n    If mIsHorizontal Then\n        positionRatio = mLabelLineFull.Width / mLabelLineEmpty.Width\n    Else\n        positionRatio = mLabelLineFull.Height / mLabelLineEmpty.Height\n    End If\n\n    ' Calculate the raw value based on position ratio\n    Dim rawValue As Double\n    rawValue = mMinValue + positionRatio * (mMaxValue - mMinValue)\n\n    ' Apply step increment to the value\n    Dim stepValue As Double\n    stepValue = (rawValue - mMinValue) / mStep\n    If (stepValue - Fix(stepValue)) > 0.5 Then\n        getValue = mMinValue + Fix(stepValue) * mStep + mStep\n    Else\n        getValue = mMinValue + Fix(stepValue) * mStep\n    End If\n\n    ' Ensure the value is within bounds\n    If getValue > mMaxValue Then\n        getValue = mMaxValue\n    ElseIf getValue < mMinValue Then\n        getValue = mMinValue\n    End If\n\n    mValue = getValue\n    Call SetValue(mValue)\nEnd Function\n\n' Sets the slider value and updates the position of the controls\n' Sets the slider value and updates the position of the controls\n' Accepts a new value and adjusts the slider control positions accordingly\n' Example usage: Call slider.SetValue(75)\nPrivate Sub SetValue(ByRef snValue As Single)\n    mValue = snValue\n    Call UpdateSliderLinePosition\n    Call UpdateButtonPosition\n    Call UpdateValueLabelDisplay\nEnd Sub\n\n' Updates the position and size of the slider line based on the current value\nPrivate Sub UpdateSliderLinePosition()\n    With mLabelLineFull\n        If mIsHorizontal Then\n            .Height = mLabelLineEmpty.Height\n            ' Check for division by zero\n            If mMaxValue <> mMinValue Then\n                .Width = (mValue - mMinValue) / (mMaxValue - mMinValue) * mLabelLineEmpty.Width\n            Else\n                .Width = 0\n            End If\n        Else\n            ' Check for division by zero\n            If mMaxValue <> mMinValue Then\n                .Height = (mValue - mMinValue) / (mMaxValue - mMinValue) * mLabelLineEmpty.Height\n            Else\n                .Height = 0\n            End If\n            .Width = mLabelLineEmpty.Width\n        End If\n    End With\nEnd Sub\n\n' Updates the position of the slider button based on the current value and orientation\nPrivate Sub UpdateButtonPosition()\n    With mTxtBtn\n        If mIsHorizontal Then\n            .Top = mLabelLineEmpty.Top + mLabelLineEmpty.Height / 2 - .Height / 2 + 3\n            .Left = mLabelLineFull.Left + mLabelLineFull.Width - .Width / 2\n        Else\n            .Top = mLabelLineFull.Top + mLabelLineFull.Height - .Height / 2\n            .Left = mLabelLineEmpty.Left + mLabelLineEmpty.Width / 2 - .Width / 2 - 3\n        End If\n    End With\nEnd Sub\n\n' Updates the value label display with the current value and format\nPrivate Sub UpdateValueLabelDisplay()\n    With mLabelValue\n        .Height = 10\n        .Width = 30\n        Call UpdateValueLabelPosition(mPositionValue)\n        .Caption = mValue\n        If mFormatValue <> vbNullString Then .Caption = VBA.Format$(mValue, mFormatValue)\n    End With\nEnd Sub\n\n' Additional helper methods for improved maintainability\n' These methods separate concerns and make the code more modular\n\n' Validates that the minimum value is less than the maximum value\nPrivate Function IsValidRange() As Boolean\n    IsValidRange = (mMinValue < mMaxValue)\nEnd Function\n\n' Calculates the position ratio of the current value within the slider range\nPrivate Function CalculatePositionRatio() As Double\n    If mMaxValue <> mMinValue Then\n        CalculatePositionRatio = (mValue - mMinValue) / (mMaxValue - mMinValue)\n    Else\n        CalculatePositionRatio = 0\n    End If\nEnd Function\n\n' Ensures the given value is within the valid range\nPrivate Function ConstrainValue(ByVal inputValue As Single) As Single\n    If inputValue < mMinValue Then\n        ConstrainValue = mMinValue\n    ElseIf inputValue > mMaxValue Then\n        ConstrainValue = mMaxValue\n    Else\n        ConstrainValue = inputValue\n    End If\nEnd Function\n\n' Changes the position of the slider value label depending on the given position\n' Changes the position of the slider value label based on the specified position\n' Accepts a value from the PositionValue enumeration and sets the appropriate label position\n' Example usage: Call slider.changePositionLabelValue(clsSlider.PositionValue.Right)\nPrivate Sub UpdateValueLabelPosition(ByVal pos As PositionValue)\n    With mLabelValue\n        Select Case pos\n            Case PositionValue.Top:\n                .Top = mLabelLineEmpty.Top - .Height - 5\n                .Left = mLabelLineEmpty.Left + mLabelLineEmpty.Width / 2 - .Width / 2\n            Case PositionValue.Left:\n                .Top = mLabelLineEmpty.Top + mLabelLineEmpty.Height / 2 - .Height / 2\n                .Left = mLabelLineEmpty.Left - .Width\n            Case PositionValue.Right:\n                .Top = mLabelLineEmpty.Top + mLabelLineEmpty.Height / 2 - .Height / 2\n                .Left = mLabelLineEmpty.Left + mLabelLineEmpty.Width + 5\n            Case PositionValue.Bottom:\n                .Top = mLabelLineEmpty.Top + mLabelLineEmpty.Height + 5\n                .Left = mLabelLineEmpty.Left + mLabelLineEmpty.Width / 2 - .Width / 2\n        End Select\n    End With\nEnd Sub\n\n' Clean up resources when the class object is destroyed\n' Sets all internal objects to Nothing to prevent memory leaks\nPrivate Sub Class_Terminate()\n    Set mTxtBtn = Nothing\n    Set mLabelLineEmpty = Nothing\n    Set mLabelLineFull = Nothing\n    Set mLabelValue = Nothing\n    Set mParent = Nothing\nEnd Sub", 
      "CODE": "Private WithEvents clsSL As clsSlider\r\n\r\n    Set clsSL = New clsSlider\r\n    Call clsSL.Initialize(Label1, 60, 50, 100, True)", 
      "DISCRIPTION": "Класс создания контрола слайдера"
    }, 
    {
      "CODE_GRUP": "Forms", 
      "CODE_SNIPPET": "clsTextArea", 
      "clsTextArea.cls": "\n''========================================================================================\n' Class: clsTextArea\n' Author: VBATools\n' Version: 1.0.1\n' Creation Date: 12.11.2025 16:50\n' Last Update Date: 12.11.2025 23:57\n' License: Apache License\n'========================================================================================\n\nPrivate Const RESIZE_HANDLE = \"_handle\"\nPrivate WithEvents mResizeHandle As MSForms.Label\nPrivate mTextBox    As MSForms.textBox\n\nPrivate snTop       As Single\nPrivate snLeft      As Single\n\nPrivate snMinHeight As Single\nPrivate snMinWidth  As Single\nPrivate snMaxHeight As Single\nPrivate snMaxWidth  As Single\nPrivate snOldHeight As Single\nPrivate snOldWidth  As Single\n\nPublic Property Get Version() As String\n    Version = \"Class: clsTextArea\" & vbNewLine & _\n            \"Author: VBATools\" & vbNewLine & _\n            \"Version: 1.0.1\" & vbNewLine & _\n            \"Date of creation: 12.11.2025 16:50\" & vbNewLine & _\n            \"Date of update: 12.11.2025 23:57\" & vbNewLine & _\n            \"License: Apache\" & vbNewLine & _\n            \"Description:\"\nEnd Property\n\nPublic Sub Initialize(ByRef textBox As MSForms.textBox, Optional maxSizeHeight As Single, Optional maxSizeWidth As Single)\n    Set mTextBox = textBox\n    With mTextBox\n        .MultiLine = True\n        Call .ZOrder(0)\n        snTop = .Top\n        snLeft = .Left\n        snMinHeight = .Height\n        snMinWidth = .Width\n        snOldHeight = snMinHeight\n        snOldWidth = snMinWidth\n        Set mResizeHandle = mTextBox.Parent.Controls.Add(\"Forms.label.1\", .Name & RESIZE_HANDLE, True)\n    End With\n    With mResizeHandle\n        With .Font\n            .Name = \"Marlett\"\n            .Charset = 2\n            .Size = 14\n            .Bold = True\n        End With\n        .BackStyle = fmBackStyleTransparent\n        .BorderStyle = fmBorderStyleNone\n        .MousePointer = fmMousePointerSizeNWSE\n        .AutoSize = True\n        .Caption = \"o\"\n        .ForeColor = &HC0C0C0\n        .Top = snTop + snOldHeight - .Height\n        .Left = snLeft + snOldWidth - .Width\n        Call .ZOrder(0)\n    End With\n    With mTextBox.Parent\n        snMaxHeight = .InsideHeight - snTop\n        If maxSizeHeight <> 0 Then snMaxHeight = maxSizeHeight\n        If snMaxHeight + snTop > .InsideHeight Then snMaxHeight = .InsideHeight - snTop\n\n        snMaxWidth = .InsideWidth - snLeft\n        If maxSizeWidth <> 0 Then snMaxWidth = maxSizeWidth\n        If snMaxWidth + snLeft > .InsideWidth Then snMaxWidth = .InsideWidth - snLeft\n    End With\nEnd Sub\n\nPrivate Sub mResizeHandle_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)\n    If Button = 1 Then\n        Dim sngSize As Single\n        With mTextBox\n            If .Width + x <= snMaxWidth Then\n                sngSize = .Width + x\n                If sngSize < snMinWidth Then sngSize = snMinWidth\n                If sngSize > snMaxWidth Then sngSize = snMaxWidth\n                .Width = sngSize\n                mResizeHandle.Left = .Left + .Width - mResizeHandle.Width\n            End If\n\n            If .Height + y <= snMaxHeight Then\n                sngSize = .Height + y\n                If sngSize < snMinHeight Then sngSize = snMinHeight\n                If sngSize > snMaxHeight Then sngSize = snMaxHeight\n                .Height = sngSize\n                mResizeHandle.Top = .Top + .Height - mResizeHandle.Height\n            End If\n        End With\n    End If\nEnd Sub\n\nPrivate Sub mResizeHandle_DblClick(ByVal Cancel As MSForms.ReturnBoolean)\n    With mTextBox\n        If .Height = snOldHeight Then\n            .Height = snMaxHeight\n        Else\n            .Height = snOldHeight\n        End If\n        If .Width = snOldWidth Then\n            .Width = snMaxWidth\n        Else\n            .Width = snOldWidth\n        End If\n\n        mResizeHandle.Left = .Left + .Width - mResizeHandle.Width\n        mResizeHandle.Top = .Top + .Height - mResizeHandle.Height\n    End With\nEnd Sub", 
      "CODE": "Dim clsTA As clsTextArea\r\n\r\nSet clsTA = New clsTextArea\r\nCall clsTA.Initialize(TextBox1, Me.Height, Me.Width)", 
      "DISCRIPTION": "Класс создания контрола TextArea"
    }, 
    {
      "CODE_GRUP": "Forms", 
      "CODE_SNIPPET": "clsTextboxMask", 
      "clsTextboxMask.cls": "\n'========================================================================================\n' Class: clsTextboxMask\n' Author: VBATools\n' Version: 1.0.7\n' Creation Date: 05.11.2025 10:30\n' Last Update Date: 11.11.2025 15:57\n' License: Apache License\n'========================================================================================\n' Purpose:\n'   Class for creating textbox fields with input masks in VBA. Provides input validation, placeholder display\n'   and visual indication of field fill status. Supports various mask types: numeric, letters, dates,\n'   phone numbers and others.\n'\n' Main Features:\n'   - Support for various input mask types (numbers, dates, time, text, regular expressions)\n'   - Real-time input validation\n'   - Display of placeholders with different statuses (empty, partially filled, completely filled, invalid)\n'   - Visual indication of input correctness through border color\n'   - Support for numeric values with range, sign and decimal restrictions\n'   - Support for variable length text\n'   - Support for validation via regular expressions\n'\n' Usage Examples:\n'   1. Creating a numeric field with constraints:\n'      Dim numField As New clsTextboxMask\n'      Call numField.AddFieldNumeric(inputTextBox:=Me.TextBox1, _\n       '                                   minValue:=0, _\n       '                                   maxValue:=100, _\n       '                                   allowDecimal:=True)\n'\n'   2. Creating a date field:\n'      Dim dateField As New clsTextboxMask\n'      Call dateField.AddFieldDate(inputTextBox:=Me.TextBox2, _\n       '                                 dateMask:=\"##.##.####\", _\n       '                                 minDate:=#1/1/2020#, _\n       '                                 maxDate:=#12/31/2030#, _\n       '                                 dateFormat:=\"dd.mm.yyyy\")\n'\n'   3. Creating a text field with mask:\n'      Dim textField As New clsTextboxMask\n'      Call textField.AddFieldText(inputTextBox:=Me.TextBox3, _\n       '                                 textMask:=\"+7(*##) @# A# #?‘#\")  ' Letters-digits\n'\n' Dependencies:\n'   - MSForms.TextBox\n'   - MSForms.Label\n'   - VBScript.RegExp (for validation via regular expressions)\n'\n'========================================================================================\n\nPublic Enum enumTypeMask\n    tOtherFix = 1\n    tDateFix\n    tTimeFix\n    tNumeric\n    tVariableLen\n    tRegex\n    [_First] = tOtherFix\n    [_Last] = tRegex\nEnd Enum\n\nPrivate Const HOLDER As String = \"_holder\"\n\nPrivate mSimvolsMasks As String\nPrivate mBorderColorValid As Long\nPrivate mBorderColorInvalid As Long\n\nPrivate WithEvents mTextBox As MSForms.TextBox\nPrivate mLabelPlaceholder As MSForms.label\nPrivate mLabelStatus As MSForms.label\n\nPrivate mItems      As Collection\n\nPrivate mMask       As String\nPrivate mFormatValue As String\n\nPrivate mRegexPattern As String             ' Regular expression pattern for tRegex masks\nPrivate mRegexFilter As String              ' Regular expression filter\nPrivate mRegex      As Object               ' Cached regex object for tRegex masks\n\nPrivate mPlaceholderEmpty As String         ' Placeholder text when field is empty\nPrivate mPlaceholderPartial As String       ' Placeholder text when field is partially filled\nPrivate mPlaceholderComplete As String      ' Placeholder text when field is completely filled\nPrivate mPlaceholderInvalid As String       ' Placeholder text when field contains invalid data\nPrivate mPlaceholderTemplate As String      ' Example text for placeholders\n\nPrivate mPlaceholderEmptyColor As Long      ' Color for empty placeholder\nPrivate mPlaceholderPartialColor As Long    ' Color for partial placeholder\nPrivate mPlaceholderCompleteColor As Long   ' Color for complete placeholder\nPrivate mPlaceholderInvalidColor As Long    ' Color for invalid placeholder\nPrivate mStatusPositionLeft As Boolean\n\nPrivate mIsDecimal  As Boolean\n\nPrivate mMin        As Single\nPrivate mMax        As Single\n\nPrivate mCurrentMaskType As enumTypeMask\n\nPublic Property Get ConstSimvolsMasks() As String\n    ConstSimvolsMasks = mSimvolsMasks\nEnd Property\n\n'========================================================================================\n' Property: PlaceholderMask\n'========================================================================================\n' Purpose:\n'   Returns the current placeholder mask, which shows the remaining characters that need to be filled in the textbox\n'   If the textbox value is shorter than the mask length, the placeholder will show the remaining mask characters\n'   If the textbox value is equal to or longer than the mask length, the placeholder will be empty\n'\n' Return Value:\n'   String - The placeholder mask showing remaining characters to be filled\n'========================================================================================\nPublic Property Get PlaceholderMask() As String\n    If Me.TextBox Is Nothing Then Exit Property\n\n    Dim LenValue    As Integer\n    Dim lenMask     As Integer\n    Dim sMask       As String\n\n    LenValue = Me.LenValue\n    lenMask = Me.lenMask\n    sMask = Me.Mask\n\n    If lenMask >= LenValue Then\n        PlaceholderMask = Me.Value & VBA.Mid$(sMask, LenValue + 1, lenMask - LenValue)\n    Else\n        PlaceholderMask = sMask\n    End If\nEnd Property\n\nPublic Property Get PlaceholderEmpty() As String\n    PlaceholderEmpty = mPlaceholderEmpty\nEnd Property\n\nPublic Property Let PlaceholderEmpty(ByVal Value As String)\n    mPlaceholderEmpty = Value\nEnd Property\n\nPublic Property Get PlaceholderPartial() As String\n    PlaceholderPartial = mPlaceholderPartial\nEnd Property\n\nPublic Property Let PlaceholderPartial(ByVal Value As String)\n    mPlaceholderPartial = Value\nEnd Property\n\nPublic Property Get PlaceholderComplete() As String\n    PlaceholderComplete = mPlaceholderComplete\nEnd Property\n\nPublic Property Let PlaceholderComplete(ByVal Value As String)\n    mPlaceholderComplete = Value\nEnd Property\n\nPublic Property Get PlaceholderInvalid() As String\n    PlaceholderInvalid = mPlaceholderInvalid\nEnd Property\n\nPublic Property Let PlaceholderInvalid(ByVal Value As String)\n    mPlaceholderInvalid = Value\nEnd Property\n\nPublic Property Get PlaceHolderTemplate() As String\n    PlaceHolderTemplate = mPlaceholderTemplate\nEnd Property\n\nPublic Property Let PlaceHolderTemplate(ByVal Value As String)\n    mPlaceholderTemplate = Value\nEnd Property\n\nPublic Property Get VisibleLabelStatus() As Boolean\n    If Me.LabelStatus Is Nothing Then Exit Property\n    VisibleLabelStatus = Me.LabelStatus.Visible\nEnd Property\n\nPublic Property Let VisibleLabelStatus(ByVal Value As Boolean)\n    If Me.LabelStatus Is Nothing Then Exit Property\n    Me.LabelStatus.Visible = Value\nEnd Property\n\nPublic Property Get VisibleLabelPlaceholder() As Boolean\n    If Me.LabelPlaceholder Is Nothing Then Exit Property\n    VisibleLabelPlaceholder = Me.LabelPlaceholder.Visible\nEnd Property\n\nPublic Property Let VisibleLabelPlaceholder(ByVal Value As Boolean)\n    If Me.LabelPlaceholder Is Nothing Then Exit Property\n    Me.LabelPlaceholder.Visible = Value\nEnd Property\n\nPublic Property Get PlaceholderEmptyColor() As Long\n    PlaceholderEmptyColor = mPlaceholderEmptyColor\nEnd Property\n\nPublic Property Let PlaceholderEmptyColor(ByVal Value As Long)\n    mPlaceholderEmptyColor = Value\nEnd Property\n\nPublic Property Get PlaceholderPartialColor() As Long\n    PlaceholderPartialColor = mPlaceholderPartialColor\nEnd Property\n\nPublic Property Let PlaceholderPartialColor(ByVal Value As Long)\n    mPlaceholderPartialColor = Value\nEnd Property\n\nPublic Property Get PlaceholderCompleteColor() As Long\n    PlaceholderCompleteColor = mPlaceholderCompleteColor\nEnd Property\n\nPublic Property Let PlaceholderCompleteColor(ByVal Value As Long)\n    mPlaceholderCompleteColor = Value\nEnd Property\n\nPublic Property Get PlaceholderInvalidColor() As Long\n    PlaceholderInvalidColor = mPlaceholderInvalidColor\nEnd Property\n\nPublic Property Let PlaceholderInvalidColor(ByVal Value As Long)\n    mPlaceholderInvalidColor = Value\nEnd Property\n\nPublic Property Let BorderColorValid(ByRef Color As Long)\n    mBorderColorValid = Color\nEnd Property\n\nPublic Property Get BorderColorValid() As Long\n    BorderColorValid = mBorderColorValid\nEnd Property\n\nPublic Property Let BorderColorInvalid(ByRef Color As Long)\n    mBorderColorInvalid = Color\nEnd Property\n\nPublic Property Get BorderColorInvalid() As Long\n    BorderColorInvalid = mBorderColorInvalid\nEnd Property\n\nPublic Property Get Min() As Single\n    Min = mMin\nEnd Property\n\nPublic Property Let Min(ByVal Value As Single)\n    mMin = Value\nEnd Property\n\nPublic Property Get Max() As Single\n    Max = mMax\nEnd Property\n\nPublic Property Let Max(ByVal Value As Single)\n    mMax = Value\nEnd Property\n\nPublic Property Get IsDecimal() As Boolean\n    IsDecimal = mIsDecimal\nEnd Property\n\nPublic Property Let IsDecimal(ByVal Value As Boolean)\n    mIsDecimal = Value\nEnd Property\n\nPublic Property Get TextBox() As MSForms.TextBox\n    Set TextBox = mTextBox\nEnd Property\n\nPublic Property Set TextBox(ByRef TextBox As MSForms.TextBox)\n    Set mTextBox = TextBox\nEnd Property\n\nPublic Property Get LabelPlaceholder() As MSForms.label\n    Set LabelPlaceholder = mLabelPlaceholder\nEnd Property\n\nPublic Property Set LabelPlaceholder(ByRef label As MSForms.label)\n    Set mLabelPlaceholder = label\nEnd Property\n\nPublic Property Get LabelStatus() As MSForms.label\n    Set LabelStatus = mLabelStatus\nEnd Property\n\nPublic Property Set LabelStatus(ByRef label As MSForms.label)\n    Set mLabelStatus = label\nEnd Property\n\nPublic Property Get StatusPositionLeft() As Boolean\n    StatusPositionLeft = mStatusPositionLeft\nEnd Property\n\nPublic Property Let StatusPositionLeft(ByRef Value As Boolean)\n    mStatusPositionLeft = Value\n    With Me.LabelStatus\n        If Value Then\n            .left = Me.TextBox.left - .width\n        Else\n            .left = Me.TextBox.left + Me.TextBox.width\n        End If\n    End With\nEnd Property\n\n\nPublic Property Get Items() As Collection\n    Set Items = mItems\nEnd Property\n\nPublic Property Set Items(ByRef Items As Collection)\n    Set mItems = Items\nEnd Property\n\nPublic Property Get CurrentMaskType() As enumTypeMask\n    CurrentMaskType = mCurrentMaskType\nEnd Property\n\nPublic Property Let CurrentMaskType(ByVal maskType As enumTypeMask)\n    mCurrentMaskType = maskType\nEnd Property\n\nPublic Property Get LenValue() As Integer\n    If Me.TextBox Is Nothing Then Exit Property\n    LenValue = VBA.Len(Me.Value)\nEnd Property\n\nPublic Property Let Value(ByRef Value As String)\n    If Me.TextBox Is Nothing Then Exit Property\n    Me.TextBox.Value = Value\nEnd Property\n\nPublic Property Get Value() As String\n    If Me.TextBox Is Nothing Then Exit Property\n    Value = Me.TextBox.Value\nEnd Property\n\nPublic Property Let Mask(ByRef Mask As String)\n    mMask = Mask\nEnd Property\n\nPublic Property Get Mask() As String\n    Mask = mMask\nEnd Property\n\nPublic Property Get lenMask() As Integer\n    lenMask = VBA.Len(Me.Mask)\nEnd Property\n\nPublic Property Let FormatValue(ByRef FormatValue As String)\n    mFormatValue = FormatValue\nEnd Property\n\nPublic Property Get FormatValue() As String\n    FormatValue = mFormatValue\nEnd Property\n\nPublic Property Let RegexPattern(ByRef RegexPattern As String)\n    mRegexPattern = RegexPattern\n    If RegexPattern <> vbNullString Then Call InitializeRegex\nEnd Property\n\nPublic Property Get RegexPattern() As String\n    RegexPattern = mRegexPattern\nEnd Property\n\nPublic Property Let RegexFilter(ByRef RegexFilter As String)\n    mRegexFilter = RegexFilter\n    If RegexFilter <> vbNullString Then Call InitializeRegex\nEnd Property\n\nPublic Property Get RegexFilter() As String\n    RegexFilter = mRegexFilter\nEnd Property\n\nPublic Property Get Count() As Byte\n    Count = Me.Items.Count\nEnd Property\n\nPublic Property Get RemainingChars() As Integer\n    If Me.TextBox Is Nothing Then\n        RemainingChars = Me.lenMask\n        Exit Property\n    End If\n    RemainingChars = Me.lenMask - Me.LenValue\nEnd Property\n\nPublic Property Get getItemByIndex(ByVal index As Integer) As clsTextboxMask\n    On Error GoTo endGetItem\n    If Not Me.Items Is Nothing Then Set getItemByIndex = Me.Items(index)\n    Exit Property\nendGetItem:\n    ' Don't clear the error, but log it for diagnostics\n    Select Case Err.Number\n        Case 0, 5\n        Case Else\n            Call Err.Raise(vbObjectError + 104, \"clsTextboxMask Error in GetItemByIndex: \", \"Number: \" & Err.Number & \" \" & Err.Description)\n            Set getItemByIndex = Nothing\n    End Select\nEnd Property\n\nPublic Property Get getItemByName(ByVal Name As String) As clsTextboxMask\n    On Error GoTo endGetItem\n    If Not Me.Items Is Nothing Then Set getItemByName = Me.Items(Name)\n    Exit Property\nendGetItem:\n    ' Don't clear the error, but log it for diagnostics\n    Select Case Err.Number\n        Case 0, 5\n        Case Else\n            Call Err.Raise(vbObjectError + 105, \"clsTextboxMask Error in GetItemByName: \", \"Number: \" & Err.Number & \" \" & Err.Description)\n            Set getItemByName = Nothing\n    End Select\nEnd Property\n\nPublic Property Get getItemsIsValid() As Boolean\n    If Me.Items Is Nothing Then Exit Property\n    Dim item        As clsTextboxMask\n    For Each item In Me.Items\n        If item.IsValid = False Then Exit Property\n    Next item\n    getItemsIsValid = True\nEnd Property\n\nPublic Property Get getItemsValue() As Variant\n    If Me.Items Is Nothing Then Exit Property\n    Dim item        As clsTextboxMask\n    Dim i           As Integer\n    ReDim arr(1 To Me.Count, 1 To 2)\n    For Each item In Me.Items\n        With item\n            If .IsValid = False Then Exit Property\n            i = i + 1\n            arr(i, 1) = .TextBox.Name\n            arr(i, 2) = .Value\n        End With\n    Next item\n    getItemsValue = arr\nEnd Property\n\nPublic Property Get Version() As String\n    Version = \"Class: clsTextboxMask\" & vbNewLine & _\n            \"Author: VBATools\" & vbNewLine & _\n            \"Version: 1.0.7\" & vbNewLine & _\n            \"Date of creation: 05.11.2025 10:30\" & vbNewLine & _\n            \"Date of update: 11.11.2025 15:57\" & vbNewLine & _\n            \"License: Apache\" & vbNewLine & _\n            \"Description: Class for creating textboxes with input masks in VBA\" & vbNewLine & _\n            \"Supports various mask types: digital, letters, dates, phone numbers, etc.\" & vbNewLine & _\n            \"Provides input validation, placeholder display, and visual indication\" & vbNewLine & _\n            \"of field fill status.\"\nEnd Property\n\n' ========================================================================================\n' Procedure: AddFieldNumeric\n' ========================================================================================\n' Purpose:\n'   Adds a numeric field with specified validation parameters\n'\n' Parameters:\n'   inputTextBox - textbox field to which the mask is applied\n'   minValue - minimum allowed value\n'   maxValue - maximum allowed value\n'   allowDecimal - allow input of decimal values\n'   showPlaceholder - show placeholder\n'   numberFormat - number display format\n'   BorderColorValid - border color for correct input\n'   BorderColorInvalid - border color for incorrect input\n'   PlaceholderEmptyColor  - placeholder color\n'   PlaceholderEmpty - placeholder text for empty field\n'   PlaceholderPartial - placeholder text for partially filled field\n'   PlaceholderComplete - placeholder text for completely filled field\n'   PlaceholderInvalid - placeholder text for field with invalid data\n'   PlaceHolderTemplete - placeholder template\n' ========================================================================================\nPublic Sub AddFieldNumeric(ByRef inputTextBox As MSForms.TextBox, _\n        ByVal minValue As Single, _\n        ByVal maxValue As Single, _\n        ByVal allowDecimal As Boolean, _\n        Optional ShowStatus As Boolean = True, _\n        Optional StatusPositionLeft As Boolean = True, _\n        Optional ShowPlaceholder As Boolean = True, _\n        Optional numberFormat As String = \"#.0\", _\n        Optional BorderColorValid As XlRgbColor = 0, _\n        Optional BorderColorInvalid As XlRgbColor = 0, _\n        Optional PlaceholderEmptyColor As XlRgbColor = 0, _\n        Optional PlaceholderEmpty As String = vbNullString, _\n        Optional PlaceholderPartialColor As XlRgbColor = 0, _\n        Optional PlaceholderPartial As String = vbNullString, _\n        Optional PlaceholderCompleteColor As XlRgbColor = 0, _\n        Optional PlaceholderComplete As String = vbNullString, _\n        Optional PlaceholderInvalidColor As XlRgbColor = 0, _\n        Optional PlaceholderInvalid As String = vbNullString, _\n        Optional PlaceHolderTemplate As String = \"{holder}\")\n\n    Call AddField(inputTextBox:=inputTextBox, _\n            textMask:=VBA.String$(WorksheetFunction.Max(VBA.Len(minValue), VBA.Len(maxValue)), \"#\"), _\n            maskType:=enumTypeMask.tNumeric, _\n            FormatValue:=numberFormat, _\n            allowDecimal:=allowDecimal, _\n            BorderColorValid:=BorderColorValid, _\n            BorderColorInvalid:=BorderColorInvalid, _\n            minValue:=minValue, _\n            maxValue:=maxValue, _\n            ShowPlaceholder:=ShowPlaceholder, _\n            PlaceholderEmptyColor:=PlaceholderEmptyColor, _\n            PlaceholderPartialColor:=PlaceholderPartialColor, _\n            PlaceholderCompleteColor:=PlaceholderCompleteColor, _\n            PlaceholderInvalidColor:=PlaceholderInvalidColor, _\n            RegexPattern:=vbNullString, _\n            PlaceholderEmpty:=PlaceholderEmpty, _\n            PlaceholderPartial:=PlaceholderPartial, _\n            PlaceholderComplete:=PlaceholderComplete, _\n            PlaceholderInvalid:=PlaceholderInvalid, _\n            PlaceHolderTemplate:=PlaceHolderTemplate, _\n            RegexFilter:=vbNullString, _\n            ShowStatus:=ShowStatus, _\n            StatusPositionLeft:=StatusPositionLeft)\nEnd Sub\n\n' ========================================================================================\n' Procedure: AddFieldDate\n' ========================================================================================\n' Purpose:\n'   Adds a date input field with specified validation parameters\n'\n' Parameters:\n'   inputTextBox - textbox field to which the mask is applied\n'   dateMask - date input mask\n'   minDate - minimum allowed date\n'   maxDate - maximum allowed date\n'   dateFormat - date display format\n'   showPlaceholder - show placeholder\n'   BorderColorValid - border color for correct input\n'   BorderColorInvalid - border color for incorrect input\n'   PlaceholderEmptyColor  - placeholder color\n'   PlaceholderEmpty - placeholder text for empty field\n'   PlaceholderPartial - placeholder text for partially filled field\n'   PlaceholderComplete - placeholder text for completely filled field\n'   PlaceholderInvalid - placeholder text for field with invalid data\n'   PlaceHolderTemplete - placeholder template\n' ========================================================================================\nPublic Sub AddFieldDate(ByRef inputTextBox As MSForms.TextBox, ByVal dateMask As String, _\n        ByVal minDate As Date, _\n        ByVal maxDate As Date, _\n        Optional dateFormat As String = \"dd.mm.yyyy\", _\n        Optional ShowStatus As Boolean = True, _\n        Optional StatusPositionLeft As Boolean = True, _\n        Optional ShowPlaceholder As Boolean = True, _\n        Optional BorderColorValid As XlRgbColor = 0, _\n        Optional BorderColorInvalid As XlRgbColor = 0, _\n        Optional PlaceholderEmptyColor As XlRgbColor = 0, _\n        Optional PlaceholderEmpty As String = vbNullString, _\n        Optional PlaceholderPartialColor As XlRgbColor = 0, _\n        Optional PlaceholderPartial As String = vbNullString, _\n        Optional PlaceholderCompleteColor As XlRgbColor = 0, _\n        Optional PlaceholderComplete As String = vbNullString, _\n        Optional PlaceholderInvalidColor As XlRgbColor = 0, _\n        Optional PlaceholderInvalid As String = vbNullString, _\n        Optional PlaceHolderTemplate As String = \"{holder}\")\n\n    Call AddField(inputTextBox:=inputTextBox, _\n            textMask:=dateMask, _\n            maskType:=enumTypeMask.tDateFix, _\n            FormatValue:=dateFormat, _\n            allowDecimal:=False, _\n            BorderColorValid:=BorderColorValid, _\n            BorderColorInvalid:=BorderColorInvalid, _\n            minValue:=minDate, _\n            maxValue:=maxDate, _\n            ShowPlaceholder:=ShowPlaceholder, _\n            PlaceholderEmptyColor:=PlaceholderEmptyColor, _\n            PlaceholderPartialColor:=PlaceholderPartialColor, _\n            PlaceholderCompleteColor:=PlaceholderCompleteColor, _\n            PlaceholderInvalidColor:=PlaceholderInvalidColor, _\n            RegexPattern:=vbNullString, _\n            PlaceholderEmpty:=PlaceholderEmpty, _\n            PlaceholderPartial:=PlaceholderPartial, _\n            PlaceholderComplete:=PlaceholderComplete, _\n            PlaceholderInvalid:=PlaceholderInvalid, _\n            PlaceHolderTemplate:=PlaceHolderTemplate, _\n            RegexFilter:=vbNullString, _\n            ShowStatus:=ShowStatus, _\n            StatusPositionLeft:=StatusPositionLeft)\nEnd Sub\n\n' ========================================================================================\n' Procedure: AddFieldTime\n' ========================================================================================\n' Purpose:\n'   Adds a time input field with specified validation parameters\n'\n' Parameters:\n'   inputTextBox - textbox field to which the mask is applied\n'   timeMask - time input mask\n'   minTime - minimum allowed time\n'   maxTime - maximum allowed time\n'   timeFormat - time display format\n'   showPlaceholder - show placeholder\n'   BorderColorValid - border color for correct input\n'   BorderColorInvalid - border color for incorrect input\n'   PlaceholderEmptyColor  - placeholder color\n'   PlaceholderEmpty - placeholder text for empty field\n'   PlaceholderPartial - placeholder text for partially filled field\n'   PlaceholderComplete - placeholder text for completely filled field\n'   PlaceholderInvalid - placeholder text for field with invalid data\n'   PlaceHolderTemplete - placeholder template\n' ========================================================================================\nPublic Sub AddFieldTime(ByRef inputTextBox As MSForms.TextBox, ByVal timeMask As String, _\n        ByVal minTime As Date, _\n        ByVal maxTime As Date, _\n        Optional timeFormat As String = \"hh:mm\", _\n        Optional ShowStatus As Boolean = True, _\n        Optional StatusPositionLeft As Boolean = True, _\n        Optional ShowPlaceholder As Boolean = True, _\n        Optional BorderColorValid As XlRgbColor = 0, _\n        Optional BorderColorInvalid As XlRgbColor = 0, _\n        Optional PlaceholderEmptyColor As XlRgbColor = 0, _\n        Optional PlaceholderEmpty As String = vbNullString, _\n        Optional PlaceholderPartialColor As XlRgbColor = 0, _\n        Optional PlaceholderPartial As String = vbNullString, _\n        Optional PlaceholderCompleteColor As XlRgbColor = 0, _\n        Optional PlaceholderComplete As String = vbNullString, _\n        Optional PlaceholderInvalidColor As XlRgbColor = 0, _\n        Optional PlaceholderInvalid As String = vbNullString, _\n        Optional PlaceHolderTemplate As String = \"{holder}\")\n\n    Call AddField(inputTextBox:=inputTextBox, _\n            textMask:=timeMask, _\n            maskType:=enumTypeMask.tTimeFix, _\n            FormatValue:=timeFormat, _\n            allowDecimal:=False, _\n            BorderColorValid:=BorderColorValid, _\n            BorderColorInvalid:=BorderColorInvalid, _\n            minValue:=0, _\n            maxValue:=1, _\n            ShowPlaceholder:=ShowPlaceholder, _\n            PlaceholderEmptyColor:=PlaceholderEmptyColor, _\n            PlaceholderPartialColor:=PlaceholderPartialColor, _\n            PlaceholderCompleteColor:=PlaceholderCompleteColor, _\n            PlaceholderInvalidColor:=PlaceholderInvalidColor, _\n            RegexPattern:=vbNullString, _\n            PlaceholderEmpty:=PlaceholderEmpty, _\n            PlaceholderPartial:=PlaceholderPartial, _\n            PlaceholderComplete:=PlaceholderComplete, _\n            PlaceholderInvalid:=PlaceholderInvalid, _\n            PlaceHolderTemplate:=PlaceHolderTemplate, _\n            RegexFilter:=vbNullString, _\n            ShowStatus:=ShowStatus, _\n            StatusPositionLeft:=StatusPositionLeft)\nEnd Sub\n\n' ========================================================================================\n' Procedure: AddFieldText\n' ========================================================================================\n' Purpose:\n'   Adds a text field with specified input mask\n'\n' Parameters:\n'   inputTextBox - textbox field to which the mask is applied\n'   textMask - text input mask\n'   showPlaceholder - show placeholder\n'   BorderColorValid - border color for correct input\n'   BorderColorInvalid - border color for incorrect input\n'   PlaceholderEmptyColor  - placeholder color\n'   PlaceholderEmpty - placeholder text for empty field\n'   PlaceholderPartial - placeholder text for partially filled field\n'   PlaceholderComplete - placeholder text for completely filled field\n'   PlaceholderInvalid - placeholder text for field with invalid data\n'   PlaceHolderTemplete - placeholder template\n' ========================================================================================\nPublic Sub AddFieldText(ByRef inputTextBox As MSForms.TextBox, _\n        ByVal textMask As String, _\n        Optional ShowStatus As Boolean = True, _\n        Optional StatusPositionLeft As Boolean = True, _\n        Optional ShowPlaceholder As Boolean = True, _\n        Optional BorderColorValid As XlRgbColor = 0, _\n        Optional BorderColorInvalid As XlRgbColor = 0, _\n        Optional PlaceholderEmptyColor As XlRgbColor = 0, _\n        Optional PlaceholderEmpty As String = vbNullString, _\n        Optional PlaceholderPartialColor As XlRgbColor = 0, _\n        Optional PlaceholderPartial As String = vbNullString, _\n        Optional PlaceholderCompleteColor As XlRgbColor = 0, _\n        Optional PlaceholderComplete As String = vbNullString, _\n        Optional PlaceholderInvalidColor As XlRgbColor = 0, _\n        Optional PlaceholderInvalid As String = vbNullString, _\n        Optional PlaceHolderTemplate As String = \"{holder}\")\n\n    Call AddField(inputTextBox:=inputTextBox, _\n            textMask:=textMask, _\n            maskType:=enumTypeMask.tOtherFix, _\n            FormatValue:=vbNullString, _\n            allowDecimal:=False, _\n            BorderColorValid:=BorderColorValid, _\n            BorderColorInvalid:=BorderColorInvalid, _\n            minValue:=0, _\n            maxValue:=0, _\n            ShowPlaceholder:=ShowPlaceholder, _\n            PlaceholderEmptyColor:=PlaceholderEmptyColor, _\n            PlaceholderPartialColor:=PlaceholderPartialColor, _\n            PlaceholderCompleteColor:=PlaceholderCompleteColor, _\n            PlaceholderInvalidColor:=PlaceholderInvalidColor, _\n            RegexPattern:=vbNullString, _\n            PlaceholderEmpty:=PlaceholderEmpty, _\n            PlaceholderPartial:=PlaceholderPartial, _\n            PlaceholderComplete:=PlaceholderComplete, _\n            PlaceholderInvalid:=PlaceholderInvalid, _\n            PlaceHolderTemplate:=PlaceHolderTemplate, _\n            RegexFilter:=vbNullString, _\n            ShowStatus:=ShowStatus, _\n            StatusPositionLeft:=StatusPositionLeft)\nEnd Sub\n\n' ========================================================================================\n' Procedure: AddFieldVariableLength\n' ========================================================================================\n' Purpose:\n'   Adds a field with variable text length\n'\n' Parameters:\n'   inputTextBox - textbox field to which the mask is applied\n'   maxLength - maximum text length\n'   textMask - text input mask (optional)\n'   showPlaceholder - show placeholder\n'   BorderColorValid - border color for correct input\n'   BorderColorInvalid - border color for incorrect input\n'   PlaceholderEmptyColor  - placeholder color\n'   PlaceholderEmpty - placeholder text for empty field\n'   PlaceholderPartial - placeholder text for partially filled field\n'   PlaceholderComplete - placeholder text for completely filled field\n'   PlaceholderInvalid - placeholder text for field with invalid data\n'   PlaceHolderTemplete - placeholder template\n' ========================================================================================\nPublic Sub AddFieldVariableLength(ByRef inputTextBox As MSForms.TextBox, _\n        ByVal minLength As Integer, _\n        ByVal maxLength As Integer, _\n        Optional textMask As String = vbNullString, _\n        Optional ShowStatus As Boolean = True, _\n        Optional StatusPositionLeft As Boolean = True, _\n        Optional ShowPlaceholder As Boolean = True, _\n        Optional BorderColorValid As XlRgbColor = 0, _\n        Optional BorderColorInvalid As XlRgbColor = 0, _\n        Optional PlaceholderEmptyColor As XlRgbColor = 0, _\n        Optional PlaceholderEmpty As String = vbNullString, _\n        Optional PlaceholderPartialColor As XlRgbColor = 0, _\n        Optional PlaceholderPartial As String = vbNullString, _\n        Optional PlaceholderCompleteColor As XlRgbColor = 0, _\n        Optional PlaceholderComplete As String = vbNullString, _\n        Optional PlaceholderInvalidColor As XlRgbColor = 0, _\n        Optional PlaceholderInvalid As String = vbNullString, _\n        Optional PlaceHolderTemplate As String = \"{holder}\")\n    Dim maskStr     As String\n    If textMask <> vbNullString Then\n        If VBA.Len(textMask) < maxLength Then\n            maskStr = textMask & VBA.String$(maxLength - VBA.Len(textMask), \"*\")\n        Else\n            maskStr = textMask\n        End If\n    Else\n        ' If no mask is specified, use arbitrary text up to maxLength\n        maskStr = VBA.String$(maxLength, \"*\")\n    End If\n\n    Call AddField(inputTextBox:=inputTextBox, _\n            textMask:=maskStr, _\n            maskType:=enumTypeMask.tVariableLen, _\n            FormatValue:=vbNullString, _\n            allowDecimal:=False, _\n            BorderColorValid:=BorderColorValid, _\n            BorderColorInvalid:=BorderColorInvalid, _\n            minValue:=minLength, _\n            maxValue:=maxLength, _\n            ShowPlaceholder:=ShowPlaceholder, _\n            PlaceholderEmptyColor:=PlaceholderEmptyColor, _\n            PlaceholderPartialColor:=PlaceholderPartialColor, _\n            PlaceholderCompleteColor:=PlaceholderCompleteColor, _\n            PlaceholderInvalidColor:=PlaceholderInvalidColor, _\n            RegexPattern:=vbNullString, _\n            PlaceholderEmpty:=PlaceholderEmpty, _\n            PlaceholderPartial:=PlaceholderPartial, _\n            PlaceholderComplete:=PlaceholderComplete, _\n            PlaceholderInvalid:=PlaceholderInvalid, _\n            PlaceHolderTemplate:=PlaceHolderTemplate, _\n            RegexFilter:=vbNullString, _\n            ShowStatus:=ShowStatus, _\n            StatusPositionLeft:=StatusPositionLeft)\nEnd Sub\n\n' ========================================================================================\n' Procedure: AddFieldRegex\n' ========================================================================================\n' Purpose:\n'   Adds a field with validation via regular expression\n'\n' Parameters:\n'   inputTextBox - textbox field to which the mask is applied\n'   RegexPattern - regular expression pattern for validation\n'   RegexFilter - regular expression filter\n'   showPlaceholder - show placeholder\n'   BorderColorValid - border color for correct input\n'   BorderColorInvalid - border color for incorrect input\n'   PlaceholderEmptyColor  - placeholder color\n'   PlaceholderEmpty - placeholder text for empty field\n'   PlaceholderPartial - placeholder text for partially filled field\n'   PlaceholderComplete - placeholder text for completely filled field\n'   PlaceholderInvalid - placeholder text for field with invalid data\n'   PlaceHolderTemplete - placeholder template\n' ========================================================================================\nPublic Sub AddFieldRegex(ByRef inputTextBox As MSForms.TextBox, _\n        ByVal RegexPattern As String, _\n        ByVal RegexFilter As String, _\n        Optional ShowStatus As Boolean = True, _\n        Optional StatusPositionLeft As Boolean = True, _\n        Optional ShowPlaceholder As Boolean = True, _\n        Optional BorderColorValid As XlRgbColor = 0, _\n        Optional BorderColorInvalid As XlRgbColor = 0, _\n        Optional PlaceholderEmptyColor As XlRgbColor = 0, _\n        Optional PlaceholderEmpty As String = vbNullString, _\n        Optional PlaceholderPartialColor As XlRgbColor = 0, _\n        Optional PlaceholderPartial As String = vbNullString, _\n        Optional PlaceholderCompleteColor As XlRgbColor = 0, _\n        Optional PlaceholderComplete As String = vbNullString, _\n        Optional PlaceholderInvalidColor As XlRgbColor = 0, _\n        Optional PlaceholderInvalid As String = vbNullString, _\n        Optional PlaceHolderTemplate As String = \"{holder}\")\n\n    Call AddField(inputTextBox:=inputTextBox, _\n            textMask:=vbNullString, _\n            maskType:=enumTypeMask.tRegex, _\n            FormatValue:=vbNullString, _\n            allowDecimal:=False, _\n            BorderColorValid:=BorderColorValid, _\n            BorderColorInvalid:=BorderColorInvalid, _\n            minValue:=0, _\n            maxValue:=0, _\n            ShowPlaceholder:=ShowPlaceholder, _\n            PlaceholderEmptyColor:=PlaceholderEmptyColor, _\n            PlaceholderPartialColor:=PlaceholderPartialColor, _\n            PlaceholderCompleteColor:=PlaceholderCompleteColor, _\n            PlaceholderInvalidColor:=PlaceholderInvalidColor, _\n            RegexPattern:=RegexPattern, _\n            PlaceholderEmpty:=PlaceholderEmpty, _\n            PlaceholderPartial:=PlaceholderPartial, _\n            PlaceholderComplete:=PlaceholderComplete, _\n            PlaceholderInvalid:=PlaceholderInvalid, _\n            PlaceHolderTemplate:=PlaceHolderTemplate, _\n            RegexFilter:=RegexFilter, _\n            ShowStatus:=ShowStatus, _\n            StatusPositionLeft:=StatusPositionLeft)\nEnd Sub\n\nPrivate Sub AddField(ByRef inputTextBox As MSForms.TextBox, _\n        ByVal textMask As String, _\n        ByVal maskType As enumTypeMask, _\n        ByVal FormatValue As String, _\n        ByVal allowDecimal As Boolean, _\n        ByVal BorderColorValid As XlRgbColor, _\n        ByVal BorderColorInvalid As XlRgbColor, _\n        ByVal minValue As Single, _\n        ByVal maxValue As Single, _\n        ByVal ShowPlaceholder As Boolean, _\n        ByVal PlaceholderEmptyColor As XlRgbColor, _\n        ByVal PlaceholderEmpty As String, _\n        ByVal PlaceholderPartialColor As XlRgbColor, _\n        ByVal PlaceholderPartial As String, _\n        ByVal PlaceholderCompleteColor As XlRgbColor, _\n        ByVal PlaceholderComplete As String, _\n        ByVal PlaceholderInvalidColor As XlRgbColor, _\n        ByVal PlaceholderInvalid As String, _\n        ByVal PlaceHolderTemplate As String, _\n        ByVal RegexPattern As String, _\n        ByVal RegexFilter As String, _\n        ByVal ShowStatus As Boolean, _\n        ByVal StatusPositionLeft As Boolean)\n\n    If inputTextBox Is Nothing Then\n        Call Err.Raise(vbObjectError + 101, \"clsTextboxMask\", \"TextBox cannot be Nothing\")\n        Exit Sub\n    End If\n\n    If maskType < enumTypeMask.[_First] Or maskType > enumTypeMask.[_Last] Then\n        Call Err.Raise(vbObjectError + 102, \"clsTextboxMask\", \"Invalid mask type\")\n        Exit Sub\n    End If\n\n    If IsControlInCollection(inputTextBox.Name) Then\n        Call Err.Raise(vbObjectError + 103, \"clsTextboxMask\", \"The item has already been created\")\n        Exit Sub\n    End If\n\n    Dim itemCls     As clsTextboxMask\n    Set itemCls = New clsTextboxMask\n\n    With itemCls\n        Set .TextBox = inputTextBox\n        .Mask = textMask\n        If .lenMask > 0 Then .TextBox.maxLength = .lenMask\n\n        Dim labelName As String\n        labelName = inputTextBox.Name & HOLDER\n\n        ' Check if a label with this name already exists\n        On Error Resume Next\n        Dim existingLabel As MSForms.control\n        Set existingLabel = .TextBox.Parent.Controls(labelName)\n        On Error GoTo 0\n\n        If Not existingLabel Is Nothing Then .TextBox.Parent.Controls.Remove existingLabel.Name\n        Set .LabelPlaceholder = .TextBox.Parent.Controls.Add(\"Forms.Label.1\", labelName, True)\n\n        With .LabelPlaceholder\n            .left = itemCls.TextBox.left + 8\n            .width = itemCls.TextBox.width\n            .height = itemCls.TextBox.height * 0.6\n            .top = itemCls.TextBox.top - .height\n            .BackStyle = fmBackStyleTransparent\n            '.BorderStyle = fmBorderStyleSingle\n            .Font.Name = itemCls.TextBox.Font.Name\n            .Font.Size = itemCls.TextBox.Font.Size * 0.9\n        End With\n\n        Set .LabelStatus = .TextBox.Parent.Controls.Add(\"Forms.Label.1\", inputTextBox.Name & \"_status\", True)\n        With .LabelStatus\n            .TextAlign = fmTextAlignCenter\n            .height = itemCls.TextBox.height\n            .width = .height\n            .top = itemCls.TextBox.top + .width * 0.25\n            .BackStyle = fmBackStyleTransparent\n            '.BorderStyle = fmBorderStyleSingle\n            .Font.Name = \"Segoe MDL2 Assets\"\n            .Font.Size = itemCls.TextBox.Font.Size\n            .Font.Bold = True\n        End With\n\n        ' Use default colors if 0 is passed as parameter\n        If BorderColorValid = 0 Then\n            .BorderColorValid = Me.BorderColorValid\n        Else\n            .BorderColorValid = BorderColorValid\n        End If\n        If BorderColorInvalid = 0 Then\n            .BorderColorInvalid = Me.BorderColorInvalid\n        Else\n            .BorderColorInvalid = BorderColorInvalid\n        End If\n\n        .IsDecimal = allowDecimal\n\n        .Max = maxValue\n        .Min = minValue\n\n        .VisibleLabelPlaceholder = ShowPlaceholder\n        .StatusPositionLeft = StatusPositionLeft\n        .VisibleLabelStatus = ShowStatus\n        .CurrentMaskType = maskType\n        ' Set the regular expression for this item\n        .RegexPattern = RegexPattern\n        .RegexFilter = RegexFilter\n\n        ' Initialize placeholder texts if provided\n        .PlaceholderEmpty = PlaceholderEmpty\n        .PlaceholderPartial = PlaceholderPartial\n        .PlaceholderComplete = PlaceholderComplete\n        .PlaceholderInvalid = PlaceholderInvalid\n        .PlaceHolderTemplate = PlaceHolderTemplate\n\n        ' Set placeholder color\n        If PlaceholderInvalidColor <> 0 Then .PlaceholderInvalidColor = PlaceholderInvalidColor\n        If PlaceholderCompleteColor <> 0 Then .PlaceholderCompleteColor = PlaceholderCompleteColor\n        If PlaceholderPartialColor <> 0 Then .PlaceholderPartialColor = PlaceholderPartialColor\n        If PlaceholderEmptyColor <> 0 Then .PlaceholderEmptyColor = PlaceholderEmptyColor\n        .LabelPlaceholder.ForeColor = .PlaceholderEmptyColor\n\n        .FormatValue = IIf(FormatValue = vbNullString, maskType, FormatValue)\n\n        If mItems Is Nothing Then Set mItems = New Collection\n        Call mItems.Add(itemCls, inputTextBox.Name)\n        Call .IsValid\n        Set .Items = mItems\n        .UpdatePlaceholder\n    End With\nEnd Sub\n\nPrivate Function IsControlInCollection(ByVal controlName As String) As Boolean\n    Dim tempItem    As clsTextboxMask\n    On Error Resume Next\n    Set tempItem = getItemByName(controlName)\n    On Error GoTo 0\n    If Not tempItem Is Nothing Then IsControlInCollection = True\nEnd Function\n\nPublic Function IsValid() As Boolean\n    IsValid = IsValidInput()\nEnd Function\n\nPublic Sub Clear()\n    If Me.TextBox Is Nothing Then Exit Sub\n    Me.Value = vbNullString\nEnd Sub\n\nPublic Sub SetFocus()\n    If Me.TextBox Is Nothing Then Exit Sub\n    Me.TextBox.SetFocus\nEnd Sub\n\n' ========================================================================================\n' Procedure: RemoveItem\n' ========================================================================================\n' Purpose:\n'   Removes the textbox mask element and related components\n' ========================================================================================\nPublic Sub RemoveItem()\n    On Error Resume Next\n    If IsControlInCollection(Me.TextBox.Name) Then\n        If Not Me.LabelPlaceholder Is Nothing Then Call Me.TextBox.Parent.Controls.Remove(Me.LabelPlaceholder.Name)\n        If Not Me.LabelStatus Is Nothing Then Call Me.TextBox.Parent.Controls.Remove(Me.LabelStatus.Name)\n        Call Me.Items.Remove(Me.TextBox.Name)\n    End If\n    On Error GoTo 0\n\n    Set Me.LabelPlaceholder = Nothing\n    Set Me.LabelStatus = Nothing\n    Set Me.TextBox = Nothing\n    Set Me.Items = Nothing\nEnd Sub\n\nPrivate Sub mTextBox_Change()\n    If Me.LabelPlaceholder Is Nothing Then Exit Sub\n    Call UpdatePlaceholder\n    Call IsValidInput\nEnd Sub\n\nPrivate Sub mTextBox_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)\n    Select Case Me.CurrentMaskType\n        Case enumTypeMask.tDateFix, enumTypeMask.tTimeFix, enumTypeMask.tOtherFix:\n            Call KeyAsciiFixLenText(KeyAscii)\n        Case enumTypeMask.tNumeric\n            Call NumericValue(KeyAscii)\n        Case enumTypeMask.tVariableLen\n            ' For variable length masks, apply mask validation if mask is specified\n            If Me.Mask <> vbNullString Then\n                Call KeyAsciiFixLenText(KeyAscii)\n            End If\n        Case enumTypeMask.tRegex\n            Call KeyAsciiRegex(KeyAscii)\n        Case Else\n            ' Default case - allow all characters\n    End Select\nEnd Sub\n\n' ========================================================================================\n' Procedure: KeyAsciiFixLenText\n' ========================================================================================\n' Purpose:\n'   Handles key press events for fixed length textboxes with input masks\n'   Validates input character against the mask at the current position\n'   Automatically appends fixed characters from the mask when appropriate\n'\n' Parameters:\n'   KeyAscii - ASCII code of the pressed key (modified by reference)\n' ========================================================================================\nPrivate Sub KeyAsciiFixLenText(ByRef KeyAscii As MSForms.ReturnInteger)\n    On Error GoTo ErrorHandler\n\n    Dim LenValue    As Integer\n    Dim lenMask     As Integer\n    Dim sMask       As String\n\n    LenValue = Me.LenValue\n    lenMask = Me.lenMask\n    sMask = Me.Mask\n\n    If Me.TextBox Is Nothing Or lenMask = 0 Then\n        KeyAscii = 0\n        Exit Sub\n    End If\n\n    Dim currentLength As Integer\n    currentLength = LenValue\n    Dim i           As Integer\n    i = currentLength + 1\n    If i > lenMask Then\n        KeyAscii = 0\n        Exit Sub\n    End If\n\n    Dim endLetter   As String\n    Do\n        endLetter = VBA.Mid$(sMask, i, 1)\n        Select Case endLetter\n            Case \"#\"\n                Call NumericValue(KeyAscii)\n            Case \"@\"\n                Call LatinLetters(KeyAscii)\n            Case \"A\"\n                Call AlphaNumeric(KeyAscii)\n            Case VBA.ChrW$(1041)    ' Cyrillic letters\n                Call UniCodeLetters(KeyAscii)\n            Case VBA.ChrW$(1073)    ' Cyrillic letters and digits\n                Call UniCodeLettersNumeric(KeyAscii)\n            Case \"*\"\n                ' Allow any character\n                Call AllowAnyCharacter(KeyAscii)\n            Case Else:\n                Me.Value = Me.Value & endLetter\n        End Select\n        i = i + 1\n        If i > lenMask Then Exit Do\n    Loop While Not haveSimvol(endLetter)\n\n    Exit Sub\nErrorHandler:\n    KeyAscii = 0\nEnd Sub\n\nPrivate Function haveSimvol(ByVal sVal As String) As Boolean\n    haveSimvol = (VBA.InStr(1, Me.ConstSimvolsMasks, sVal, vbBinaryCompare) > 0)\nEnd Function\n\nPrivate Sub AllowAnyCharacter(ByRef KeyAscii As MSForms.ReturnInteger)\n    Dim sValue      As String\n    sValue = Me.Value\n    Select Case KeyAscii\n        Case 32:\n            If sValue = vbNullString Then\n                KeyAscii = 0\n            Else\n                KeyAscii = IIf(InStr(VBA.Len(sValue), sValue, \" \") > 0, 0, 32)\n            End If\n    End Select\nEnd Sub\n\nPrivate Sub NumericValue(ByRef KeyAscii As MSForms.ReturnInteger)\n    Dim sValue      As String\n    sValue = Me.Value\n    Select Case KeyAscii\n        Case 48 To 57:    ' ASCII codes for digits 0-9\n        Case 45:\n            If Me.Min < 0 Then\n                KeyAscii = IIf(sValue <> vbNullString, 0, 45)\n            Else\n                KeyAscii = 0\n            End If\n        Case 44:\n            If Me.IsDecimal Then\n                KeyAscii = IIf(InStr(1, sValue, \",\") > 0, 0, 44)\n            Else\n                KeyAscii = 0\n            End If\n        Case 46:\n            If Me.IsDecimal Then\n                KeyAscii = IIf(InStr(1, sValue, \",\") > 0, 0, 44)\n            Else\n                KeyAscii = 0\n            End If\n        Case 8:    ' ASCII code for Backspace key - allow\n            ' Do nothing, character is allowed\n        Case Else:\n            KeyAscii = 0\n    End Select\nEnd Sub\n\nPrivate Function IsValidLatinLetter(ByVal KeyAscii As Integer) As Boolean\n    IsValidLatinLetter = (KeyAscii >= 65 And KeyAscii <= 90) Or (KeyAscii >= 97 And KeyAscii <= 122)\nEnd Function\n\nPrivate Function IsValidCyrillicLetter(ByVal KeyAscii As Integer) As Boolean\n    IsValidCyrillicLetter = (KeyAscii >= 192 And KeyAscii <= 255) Or (KeyAscii >= 1040 And KeyAscii <= 1103)\nEnd Function\n\nPrivate Function IsValidDigit(ByVal KeyAscii As Integer) As Boolean\n    IsValidDigit = (KeyAscii >= 48 And KeyAscii <= 57)\nEnd Function\n\nPrivate Sub LatinLetters(ByRef KeyAscii As MSForms.ReturnInteger)\n    If IsValidLatinLetter(KeyAscii) Then\n        ' This is a Latin letter, leave as is\n    ElseIf KeyAscii = 8 Then\n        ' Backspace key, allow\n    Else\n        ' Does not meet requirements, reject\n        KeyAscii = 0\n    End If\nEnd Sub\n\nPrivate Sub UniCodeLetters(ByRef KeyAscii As MSForms.ReturnInteger)\n    If IsValidCyrillicLetter(KeyAscii) Then\n        ' This is a Cyrillic letter, leave as is\n    ElseIf KeyAscii = 8 Then\n        ' Backspace key, allow\n    Else\n        ' Does not meet requirements, reject\n        KeyAscii = 0\n    End If\nEnd Sub\n\nPrivate Sub AlphaNumeric(ByRef KeyAscii As MSForms.ReturnInteger)\n    If IsValidDigit(KeyAscii) Or IsValidLatinLetter(KeyAscii) Then\n        ' This is a digit or Latin letter, leave as is\n    ElseIf KeyAscii = 8 Then\n        ' Backspace key, allow\n    Else\n        ' Does not meet requirements, reject\n        KeyAscii = 0\n    End If\nEnd Sub\n\nPrivate Sub UniCodeLettersNumeric(ByRef KeyAscii As MSForms.ReturnInteger)\n    If IsValidDigit(KeyAscii) Or IsValidCyrillicLetter(KeyAscii) Then\n        ' This is a digit or Cyrillic letter, leave as is\n    ElseIf KeyAscii = 8 Then\n        ' Backspace key, allow\n    Else\n        ' Does not meet requirements, reject\n        KeyAscii = 0\n    End If\nEnd Sub\n\n' Function to validate input against mask characters\nPrivate Function IsValidMaskInput() As Boolean\n    Dim i           As Integer\n    Dim maskChar    As String\n    Dim inputChar   As String\n    Dim Mask        As String\n    Mask = Me.Mask\n\n    ' If mask is empty, consider it valid\n    If Mask = vbNullString Then\n        IsValidMaskInput = True\n        Exit Function\n    End If\n\n    Dim LenValue    As Integer\n    Dim lenMask     As Integer\n\n    LenValue = Me.LenValue\n    lenMask = Me.lenMask\n\n    ' Check each character of the entered value against the mask\n    For i = 1 To LenValue\n        maskChar = VBA.Mid$(Mask, i, 1)\n        inputChar = VBA.Mid$(Me.Value, i, 1)\n\n        Select Case maskChar\n            Case \"#\":    ' Digits\n                IsValidMaskInput = IsValidDigit(Asc(inputChar))\n            Case \"@\":    ' Latin letters\n                IsValidMaskInput = IsValidLatinLetter(Asc(inputChar))\n            Case \"A\":    ' Latin letters and digits\n                IsValidMaskInput = IsValidDigit(Asc(inputChar)) Or IsValidLatinLetter(Asc(inputChar))\n            Case VBA.ChrW$(1041):    ' Cyrillic letters\n                IsValidMaskInput = IsValidCyrillicLetter(Asc(inputChar))\n            Case VBA.ChrW$(1073):    ' Cyrillic letters and digits\n                IsValidMaskInput = IsValidDigit(Asc(inputChar)) Or IsValidCyrillicLetter(Asc(inputChar))\n            Case \"*\":    ' Any characters\n                IsValidMaskInput = True\n            Case Else:    ' Fixed characters\n                IsValidMaskInput = (inputChar = maskChar)\n        End Select\n\n        If Not IsValidMaskInput Then Exit Function\n    Next i\n\n    ' If less characters have been entered than the mask length, check possible remaining characters\n    If LenValue < lenMask Then\n        For i = LenValue + 1 To lenMask\n            maskChar = VBA.Mid$(Mask, i, 1)\n            ' If the remaining mask characters are not fixed, consider it valid\n            ' (the user can still enter valid characters)\n            If InStr(1, Me.ConstSimvolsMasks, maskChar, vbBinaryCompare) > 0 Then\n                IsValidMaskInput = True\n                Exit Function\n            End If\n        Next i\n    End If\nEnd Function\n\nPrivate Function IsValidRegexInput() As Boolean\n    If mRegex Is Nothing Then\n        Call InitializeRegex\n        If mRegex Is Nothing Then\n            IsValidRegexInput = False\n            Exit Function\n        End If\n    End If\n    mRegex.Pattern = Me.RegexPattern\n    On Error GoTo ErrorHandler\n    IsValidRegexInput = mRegex.Test(Me.Value)\n    Exit Function\n\nErrorHandler:\n    IsValidRegexInput = False\nEnd Function\n\nPrivate Function IsValidInput() As Boolean\n    If Me.TextBox Is Nothing Then\n        IsValidInput = False\n        Exit Function\n    End If\n\n    Dim LenValue    As Integer\n    Dim lenMask     As Integer\n    Dim sValue      As String\n    Dim snMax       As Single\n    Dim snMin       As Single\n    Dim vValue      As Variant\n\n    LenValue = Me.LenValue\n    lenMask = Me.lenMask\n    snMax = Me.Max\n    snMin = Me.Min\n    vValue = Me.Value\n\n    Select Case Me.CurrentMaskType\n        Case enumTypeMask.tDateFix, enumTypeMask.tTimeFix\n            If lenMask = LenValue Then\n                If IsDate(Me.Value) Then\n                    Me.Value = VBA.Format(VBA.CDate(vValue), Me.FormatValue)\n                    vValue = Me.Value\n                    IsValidInput = Not (snMax < VBA.CDate(vValue) Or snMin > VBA.CDate(vValue))\n                Else\n                    IsValidInput = False\n                End If\n            Else\n                IsValidInput = False\n            End If\n        Case enumTypeMask.tNumeric\n            If IsNumeric(vValue) Then\n                IsValidInput = Not (snMax < vValue Or snMin > vValue)\n            Else\n                IsValidInput = False\n            End If\n        Case enumTypeMask.tVariableLen\n            ' For variable-length masks, check that the length does not exceed the maximum\n            If snMax = 0 Then    ' If maximum length is not set, consider it valid\n                IsValidInput = True\n            ElseIf LenValue = 0 Then\n                IsValidInput = False\n            Else\n                IsValidInput = (LenValue <= snMax And LenValue >= snMin)\n            End If\n            ' Also check mask compliance if it's specified\n            If IsValidInput And Me.Mask <> vbNullString Then IsValidInput = IsValidMaskInput()\n        Case enumTypeMask.tRegex\n            ' For regular expressions, use the appropriate validation\n            IsValidInput = IsValidRegexInput()\n        Case Else\n            IsValidInput = (LenValue = lenMask)\n    End Select\n    If IsValidInput Then\n        Me.TextBox.BorderColor = Me.BorderColorValid\n    Else\n        Me.TextBox.BorderColor = Me.BorderColorInvalid\n    End If\n\nEnd Function\n\nPrivate Sub KeyAsciiRegex(ByRef KeyAscii As MSForms.ReturnInteger)\n    ' Allow backspace key\n    If KeyAscii = 8 Then Exit Sub\n\n    ' Initialize regex object if not already done\n    If mRegex Is Nothing Then\n        Call InitializeRegex\n        If mRegex Is Nothing Then Exit Sub\n    End If\n\n    ' Check if the new character is valid according to the pattern\n    On Error GoTo ErrorHandler\n    mRegex.Pattern = Me.RegexFilter\n    If Not mRegex.Test(VBA.ChrW$(KeyAscii)) Then KeyAscii = 0    ' Reject the character\n    Exit Sub\n\nErrorHandler:\n    ' If there's an error with the regex, allow the character to avoid blocking input\n    ' This could happen if the regex pattern is invalid\nEnd Sub\n\nPrivate Sub InitializeRegex()\n    On Error GoTo ErrorHandler\n    Set mRegex = CreateObject(\"VBScript.RegExp\")\n    With mRegex\n        .IgnoreCase = False\n        .Global = False\n    End With\n    Exit Sub\nErrorHandler:\n    Set mRegex = Nothing\nEnd Sub\n\n' ========================================================================================\n' Procedure: UpdatePlaceholder\n' ========================================================================================\n' Purpose:\n'   Updates the placeholder display depending on the textbox field state\n' ========================================================================================\nPublic Sub UpdatePlaceholder()\n    Call processPlaceholderStatus(Me.LabelPlaceholder)\nEnd Sub\n\nPrivate Sub processPlaceholderStatus(ByRef LabelPlaceholder As MSForms.label)\n    If LabelPlaceholder Is Nothing Then Exit Sub\n\n    Dim LenValue    As Integer\n    Dim lenMask     As Integer\n    Dim currentState As String\n    Dim currentStatus As String\n    Dim currentColor As Long\n\n    LenValue = Me.LenValue\n    lenMask = Me.lenMask\n    currentColor = Me.PlaceholderEmptyColor\n\n    If IsValidInput() Then\n        currentState = Me.PlaceholderComplete\n        currentColor = Me.PlaceholderCompleteColor\n        currentStatus = VBA.ChrW$(63372)\n    Else\n        If LenValue = 0 Then\n            currentState = Me.PlaceholderEmpty\n            currentColor = Me.PlaceholderEmptyColor\n            currentStatus = vbNullString\n        ElseIf LenValue = lenMask Then\n            currentState = Me.PlaceholderInvalid\n            currentColor = Me.PlaceholderInvalidColor\n            currentStatus = VBA.ChrW$(59153)\n        ElseIf LenValue < lenMask Then\n            currentState = Me.PlaceholderPartial\n            currentColor = Me.PlaceholderPartialColor\n            currentStatus = VBA.ChrW$(60620)\n        ElseIf Me.CurrentMaskType = tRegex Then\n            currentState = Me.PlaceholderInvalid\n            currentColor = Me.PlaceholderInvalidColor\n            currentStatus = VBA.ChrW$(59153)\n        End If\n    End If\n\n    With LabelPlaceholder\n        .ForeColor = currentColor\n        .Caption = currentState\n    End With\n    With Me.LabelStatus\n        .ForeColor = currentColor\n        .Caption = currentStatus\n    End With\n    Call processPlaceholderTemplate(LabelPlaceholder)\nEnd Sub\n\nPrivate Sub processPlaceholderTemplate(ByRef LabelPlaceholder As MSForms.label)\n    Dim result      As String\n    result = Me.PlaceHolderTemplate\n    If result = vbNullString Then Exit Sub\n\n    Dim sMask       As String\n    Dim LenValue    As Integer\n    Dim lenMask     As Integer\n\n    sMask = Me.Mask\n    LenValue = Me.LenValue\n    lenMask = Me.lenMask\n\n    ' Replace markers with actual values\n    result = VBA.Replace(result, \"{mask}\", sMask)\n    result = VBA.Replace(result, \"{filled}\", LenValue)\n    result = VBA.Replace(result, \"{remaining}\", lenMask - LenValue)\n    result = VBA.Replace(result, \"{holder}\", Me.PlaceholderMask)\n    result = VBA.Replace(result, \"{RegexPattern}\", Me.RegexPattern)\n    result = VBA.Replace(result, \"{RegexFilter}\", Me.RegexFilter)\n    If lenMask > 0 Then\n        result = VBA.Replace(result, \"{percent}\", VBA.Int((LenValue / lenMask) * 100) & \"%\")\n    Else\n        result = VBA.Replace(result, \"{percent}\", \"0%\")\n    End If\n\n    With LabelPlaceholder\n        If .Caption <> vbNullString Then .Caption = .Caption & \" \"\n        .Caption = .Caption & result\n    End With\nEnd Sub\n\nPrivate Sub class_initialize()\n    mSimvolsMasks = \"#*@A\" & VBA.ChrW$(1041) & VBA.ChrW$(1073)    ' Default mask symbols\n    mBorderColorValid = &H80000008                                ' Default valid color (usually system window text color)\n    mBorderColorInvalid = &HC0C0FF                                ' Default invalid color (light red)\n    mPlaceholderEmptyColor = rgbGray                              ' Default empty placeholder color (will use general placeholder color)\n    mPlaceholderPartialColor = rgbBrown                           ' Default partial placeholder color (will use general placeholder color)\n    mPlaceholderCompleteColor = rgbGreen                          ' Default complete placeholder color (will use general placeholder color)\n    mPlaceholderInvalidColor = rgbRed                             ' Default invalid placeholder color (will use general placeholder color)\nEnd Sub", 
      "CODE": "\r\nDim clsTB           As clsTextboxMask\r\n\r\n\r\n    Set clsTB = New clsTextboxMask\r\n    With clsTB\r\n        Call .AddFieldDate(txtDate, \"##.##.####\", dt, VBA.Date, \"dd.mm.yyyy\")\r\n    End With", 
      "DISCRIPTION": "TextBox с масками с валидацией водимых данных"
    }, 
    {
      "CODE_GRUP": "Forms", 
      "CODE_SNIPPET": "fint", 
      "CODE": "Private Sub UserForm_Initialize()\r\n    With Me\r\n        .StartUpPosition = 0\r\n        .Left = Application.Left + 0.5 * (Application.Width - .Width)\r\n        .Top = Application.Top + 0.5 * (Application.Height - .Height)\r\n    End With\r\nEnd Sub", 
      "DISCRIPTION": "USER FORMS запуск по центру открытой книги Excel"
    }, 
    {
      "CODE_GRUP": "Forms", 
      "CODE_SNIPPET": "ftxtbtn", 
      "CODE": "Private Sub AddDropButton(ByRef oControl As MSForms.TextBox)\r\n    With oControl\r\n        .DropButtonStyle = fmDropButtonStyleEllipsis    'manually\r\n        .ShowDropButtonWhen = fmShowDropButtonWhenAlways    'manually\r\n    End With\r\nEnd Sub", 
      "DISCRIPTION": "USER FORMS создание DropButton для TextBox"
    }, 
    {
      "CODE_GRUP": "Forms", 
      "CODE_SNIPPET": "ftxtbtnclick", 
      "CODE": "Private Sub txtRngRes_DropButtonClick()\r\n    \r\nEnd Sub", 
      "DISCRIPTION": "USER FORMS кликк DropButton для TextBox"
    }, 
    {
      "CODE_GRUP": "Forms", 
      "CODE_SNIPPET": "modIcon", 
      "CODE": "", 
      "DISCRIPTION": "Получение кода иконки шрифт Segoe MDL2 Assets", 
      "modIcon.bas": "\nPublic Const FONT_NAME As String = \"Segoe MDL2 Assets\"\nPrivate Const TB_ICON As String = \"TB_ICON\"\n\nPublic Enum IconEnums\n    icAccept = 1\n    icAcceptMedium\n    icAccident\n    icAccidentSolid\n    icAccounts\n    icActionCenter\n    icActionCenterAsterisk\n    icActionCenterMirrored\n    icActionCenterNotification\n    icActionCenterNotificationMirrored\n    icActionCenterQuiet\n    icActionCenterQuietNotification\n    icAdd\n    icAddBold\n    icAddFriend\n    icAddNewLine\n    icAddNewLineFill\n    icAddRemoteDevice\n    icAddSurfaceHub\n    icAddTo\n    icAdjustHologram\n    icAdmin\n    icAirplane\n    icAirplaneSolid\n    icAlignCenter\n    icAlignLeft\n    icAlignRight\n    icAllApps\n    icAllAppsMirrored\n    icAnnotation\n    icAppIconDefault\n    icApplicationGuard\n    icApps\n    icAreaChart\n    icArrowDown8\n    icArrowLeft8\n    icArrowRight8\n    icArrowUp8\n    icAspectRatio\n    icAsterisk\n    icAsteriskBadge12\n    icAttach\n    icAttachCamera\n    icAudio\n    icBack\n    icBackgroundToggle\n    icBackMirrored\n    icBackSolidBold\n    icBackSpaceQWERTY\n    icBackSpaceQWERTYLg\n    icBackSpaceQWERTYMd\n    icBackSpaceQWERTYSm\n    icBackToWindow\n    icBadge\n    icBandBattery0\n    icBandBattery1\n    icBandBattery2\n    icBandBattery3\n    icBandBattery4\n    icBandBattery5\n    icBandBattery6\n    icBank\n    icBarcodeScanner\n    icBattery0\n    icBattery1\n    icBattery10\n    icBattery2\n    icBattery3\n    icBattery4\n    icBattery5\n    icBattery6\n    icBattery7\n    icBattery8\n    icBattery9\n    icBatteryCharging0\n    icBatteryCharging1\n    icBatteryCharging10\n    icBatteryCharging2\n    icBatteryCharging3\n    icBatteryCharging4\n    icBatteryCharging5\n    icBatteryCharging6\n    icBatteryCharging7\n    icBatteryCharging8\n    icBatteryCharging9\n    icBatterySaver0\n    icBatterySaver1\n    icBatterySaver10\n    icBatterySaver2\n    icBatterySaver3\n    icBatterySaver4\n    icBatterySaver5\n    icBatterySaver6\n    icBatterySaver7\n    icBatterySaver8\n    icBatterySaver9\n    icBatteryUnknown\n    icBeta\n    icBidiLtr\n    icBidiRtl\n    icBlockContact\n    icBlocked2\n    icBlueLight\n    icBluetooth\n    icBodyCam\n    icBold\n    icBookmarks\n    icBookmarksMirrored\n    icBrightness\n    icBroom\n    icBrowsePhotos\n    icBrushSize\n    icbug\n    icBuildingEnergy\n    icBulletedList\n    icBulletedListMirrored\n    icBullseye\n    icBumperLeft\n    icBumperRight\n    icBus\n    icBusSolid\n    icButtonA\n    icButtonB\n    icButtonMenu\n    icButtonView2\n    icButtonX\n    icButtonY\n    icCafe\n    icCalculator\n    icCalculatorAddition\n    icCalculatorBackspace\n    icCalculatorDivide\n    icCalculatorEqualTo\n    icCalculatorMultiply\n    icCalculatorNegate\n    icCalculatorPercentage\n    icCalculatorSquareroot\n    icCalculatorSubtract\n    icCalendar\n    icCalendarDay\n    icCalendarMirrored\n    icCalendarReply\n    icCalendarSolid\n    icCalendarWeek\n    icCallControl\n    icCallForwarding\n    icCallForwardingMirrored\n    icCallForwardInternational\n    icCallForwardInternationalMirrored\n    icCallForwardRoaming\n    icCallForwardRoamingMirrored\n    icCalligraphyFill\n    icCalligraphyPen\n    icCalories\n    icCamera\n    icCancel\n    icCancelMedium\n    icCaption\n    icCar\n    icCaretBottomRightSolidCenter8\n    icCaretDownSolid8\n    icCaretLeftSolid8\n    icCaretRight8\n    icCaretRightSolid8\n    icCaretUpSolid8\n    icCashDrawer\n    icCC\n    icCellPhone\n    icCertificate\n    icCharacterAppearance\n    icCharacters\n    icChatBubbles\n    icCheckBox\n    icCheckbox14\n    icCheckboxComposite\n    icCheckboxComposite14\n    icCheckboxCompositeReversed\n    icCheckboxFill\n    icCheckboxIndeterminate\n    icCheckboxIndeterminateCombo\n    icCheckboxIndeterminateCombo14\n    icCheckList\n    icChecklistMirrored\n    icCheckMark\n    icCheveronLeft20\n    icCheveronLeft32\n    icCheveronRight20\n    icCheveronRight32\n    icChevronDown\n    icChevronDownMed\n    icChevronDownSmall\n    icChevronLeft\n    icChevronLeftMed\n    icChevronLeftSmall\n    icChevronRight\n    icChevronRightMed\n    icChevronRightSmall\n    icChevronUp\n    icChevronUpMed\n    icChevronUpSmall\n    icChineseBoPoMoFo\n    icChineseChangjie\n    icChinesePinyin\n    icChinesePunctuation\n    icChineseQuick\n    icChipCardCreditCardReader\n    icChromeAnnotate\n    icChromeAnnotateContrast\n    icChromeBack\n    icChromeBackContrast\n    icChromeBackContrastMirrored\n    icChromeBackMirrored\n    icChromeBackToWindow\n    icChromeBackToWindowContrast\n    icChromeClose\n    icChromeCloseContrast\n    icChromeFullScreen\n    icChromeFullScreenContrast\n    icChromeMaximize\n    icChromeMaximizeContrast\n    icChromeMinimize\n    icChromeMinimizeContrast\n    icChromeRestore\n    icChromeRestoreContrast\n    icChromeSwitch\n    icChromeSwitchContast\n    icCHTLanguageBar\n    icCircleFill\n    icCircleFillBadge12\n    icCircleRing\n    icCircleRingBadge12\n    icCircleShapeSolid\n    icCityNext\n    icCityNext2\n    icClear\n    icClearAllInk\n    icClearAllInkMirrored\n    icClearSelection\n    icClearSelectionMirrored\n    icClick\n    icClickedOutLoudSolidBold\n    icClickSolid\n    icClipboardList\n    icClipboardListMirrored\n    icClippingTool\n    icClosePane\n    icClosePaneMirrored\n    icCloud\n    icCloudPrinter\n    icCloudSearch\n    icCode\n    icCollapseContent\n    icCollapseContentSingle\n    icCollateLandscape\n    icCollateLandscapeSeparated\n    icCollatePortrait\n    icCollatePortraitSeparated\n    icColor\n    icColorOff\n    icColorSolid\n    icCommaKey\n    icCommandPrompt\n    icComment\n    icCommunications\n    icCompanionApp\n    icCompanionDeviceFramework\n    icCompleted\n    icCompletedSolid\n    icComponent\n    icComposeMode\n    icConnect\n    icConnectApp\n    icConnected\n    icConstruction\n    icConstructionCone\n    icConstructionSolid\n    icContact\n    icContact2\n    icContactInfo\n    icContactInfoMirrored\n    icContactPresence\n    icContactSolid\n    icCopy\n    icCopyTo\n    icCourthouse\n    icCrop\n    icCtrlSpatialLeft\n    icCtrlSpatialRight\n    icCut\n    icDashKey\n    icDataSense\n    icDataSenseBar\n    icDateTime\n    icDateTimeMirrored\n    icDefaultAPN\n    icDefenderApp\n    icDefenderBadge12\n    icDelete\n    icDeleteLines\n    icDeleteLinesFill\n    icDeleteWord\n    icDeleteWordFill\n    icDeliveryOptimization\n    icDesign\n    icDetachablePC\n    icDeveloperTools\n    icDeviceDiscovery\n    icDeviceLaptopNoPic\n    icDeviceLaptopPic\n    icDeviceMonitorLeftPic\n    icDeviceMonitorNoPic\n    icDeviceMonitorRightPic\n    icDevices\n    icDevices2\n    icDevices3\n    icDevices4\n    icDevUpdate\n    icDiagnostic\n    icDial1\n    icDial10\n    icDial11\n    icDial12\n    icDial13\n    icDial14\n    icDial15\n    icDial16\n    icDial2\n    icDial3\n    icDial4\n    icDial5\n    icDial6\n    icDial7\n    icDial8\n    icDial9\n    icDialpad\n    icDialShape1\n    icDialShape2\n    icDialShape3\n    icDialShape4\n    icDialUp\n    icDictionary\n    icDictionaryAdd\n    icDictionaryCloud\n    icDirectAccess\n    icDirections\n    icDisableUpdates\n    icDisconnectDisplay\n    icDisconnectDrive\n    icDislike\n    icDMC\n    icDock\n    icDockBottom\n    icDockLeft\n    icDockLeftMirrored\n    icDockRight\n    icDockRightMirrored\n    icDocument\n    icDoubleLandscape\n    icDoublePinyin\n    icDoublePortrait\n    icDown\n    icDownload\n    icDownloadMap\n    icDownShiftKey\n    icDpad\n    icDraw\n    icDrawSolid\n    icDrivingMode\n    icDrop\n    icDullSound\n    icDullSoundKey\n    icDuplexLandscapeOneSided\n    icDuplexLandscapeOneSidedMirrored\n    icDuplexLandscapeTwoSidedLongEdge\n    icDuplexLandscapeTwoSidedLongEdgeMirrored\n    icDuplexLandscapeTwoSidedShortEdge\n    icDuplexLandscapeTwoSidedShortEdgeMirrored\n    icDuplexPortraitOneSided\n    icDuplexPortraitOneSidedMirrored\n    icDuplexPortraitTwoSidedLongEdge\n    icDuplexPortraitTwoSidedLongEdgeMirrored\n    icDuplexPortraitTwoSidedShortEdge\n    icDuplexPortraitTwoSidedShortEdgeMirrored\n    icDynamicLock\n    icEar\n    icEarbud\n    icEaseOfAccess\n    icEdit\n    icEditMirrored\n    icEducation\n    icEducationIcon\n    icEject\n    icEMI\n    icEmoji\n    icEmoji2\n    icEmojiSwatch\n    icEmojiTabCelebrationObjects\n    icEmojiTabFavorites\n    icEmojiTabFoodPlants\n    icEmojiTabMoreSymbols\n    icEmojiTabPeople\n    icEmojiTabSmilesAnimals\n    icEmojiTabSymbols\n    icEmojiTabTextSmiles\n    icEmojiTabTransitPlaces\n    icEndPoint\n    icEndPointSolid\n    icEnglishPunctuation\n    icEqualizer\n    icEraseTool\n    icEraseToolFill\n    icEraseToolFill2\n    icError\n    icErrorBadge\n    icErrorBadge12\n    iceSIM\n    iceSIMBusy\n    iceSIMLocked\n    iceSIMNoProfile\n    icEthernet\n    icEthernetError\n    icEthernetWarning\n    icExpandTile\n    icExpandTileMirrored\n    icExploitProtection\n    icExploitProtectionSettings\n    icExploreContent\n    icExploreContentSingle\n    icExport\n    icExportMirrored\n    icExpressiveInputEntry\n    icEyedropper\n    icEyeGaze\n    icFamily\n    icFastForward\n    icFavicon\n    icFavicon2\n    icFavoriteList\n    icFavoriteStar\n    icFavoriteStarFill\n    icFeedback\n    icFeedbackApp\n    icFerry\n    icFerrySolid\n    icFileExplorer\n    icFileExplorerApp\n    icFilter\n    icFingerInking\n    icFingerprint\n    icFitPage\n    icFlag\n    icFlashlight\n    icFlickDown\n    icFlickLeft\n    icFlickRight\n    icFlickUp\n    icFlow\n    icFolder\n    icFolderFill\n    icFolderHorizontal\n    icFolderOpen\n    icFolderSelect\n    icFont\n    icFontColor\n    icFontDecrease\n    icFontIncrease\n    icFontSize\n    icForward\n    icForwardCall\n    icForwardMirrored\n    icForwardSm\n    icForwardSolidBold\n    icFourBars\n    icFreeFormClipping\n    icFrigid\n    icFull20\n    icFullAlpha\n    icFullCircleMask\n    icFullHiragana\n    icFullKatakana\n    icFullScreen\n    icFuzzyReading\n    icGame\n    icGameConsole\n    icGenericScan\n    icGIF\n    icGiftboxOpen\n    icGlobalNavigationButton\n    icGlobe\n    icGlobe2\n    icGo\n    icGoMirrored\n    icGoToMessage\n    icGoToStart\n    icGotoToday\n    icGridView\n    icGripperBarHorizontal\n    icGripperBarVertical\n    icGripperResize\n    icGripperResizeMirrored\n    icGripperTool\n    icGroceries\n    icGroup\n    icGroupList\n    icGuestUser\n    icHalfAlpha\n    icHalfDullSound\n    icHalfKatakana\n    icHalfStarLeft\n    icHalfStarRight\n    icHandwriting\n    icHandwriting20\n    icHangUp\n    icHardDrive\n    icHeadlessDevice\n    icHeadphone\n    icHeadphone0\n    icHeadphone1\n    icHeadphone2\n    icHeadphone3\n    icHeadset\n    icHealth\n    icHeart\n    icHeartBroken\n    icHeartFill\n    icHelp\n    icHelpMirrored\n    icHideBcc\n    icHighlight\n    icHighlightFill\n    icHighlightFill2\n    icHistory\n    icHMD\n    icHolePunchLandscapeBottom\n    icHolePunchLandscapeLeft\n    icHolePunchLandscapeRight\n    icHolePunchLandscapeTop\n    icHolePunchOff\n    icHolePunchPortraitBottom\n    icHolePunchPortraitLeft\n    icHolePunchPortraitRight\n    icHolePunchPortraitTop\n    icHoloLensSelected\n    icHome\n    icHomeGroup\n    icHomeSolid\n    icHorizontalTabKey\n    icHWPInsert\n    icHWPJoin\n    icHWPNewLine\n    icHWPOverwrite\n    icHWPScratchOut\n    icHWPSplit\n    icHWPStrikeThrough\n    icIBeam\n    icIBeamOutline\n    icImageExport\n    icImport\n    icImportAll\n    icImportAllMirrored\n    icImportant\n    icImportantBadge12\n    icImportMirrored\n    icIncidentTriangle\n    icIncomingCall\n    icInfo\n    icInfo2\n    icInfoSolid\n    icInkingCaret\n    icInkingColorFill\n    icInkingColorOutline\n    icInkingTool\n    icInkingToolFill\n    icInkingToolFill2\n    icInPrivate\n    icInputChr\n    icInsiderHubApp\n    icInstertWords\n    icInstertWordsFill\n    icInteractiveDashboard\n    icInternetSharing\n    icIOT\n    icItalic\n    icJapanese\n    icJoinWords\n    icJoinWordsFill\n    icJpnRomanji\n    icJpnRomanjiLock\n    icJpnRomanjiShift\n    icJpnRomanjiShiftLock\n    icKey12On\n    icKeyboard12Key\n    icKeyboardBrightness\n    icKeyboardClassic\n    icKeyboardDismiss\n    icKeyboardDock\n    icKeyboardFull\n    icKeyboardLeftAligned\n    icKeyboardLeftDock\n    icKeyboardLeftHanded\n    icKeyboardLowerBrightness\n    icKeyboardNarrow\n    icKeyboardOneHanded\n    icKeyboardRightAligned\n    icKeyboardRightDock\n    icKeyboardRightHanded\n    icKeyboardSettings\n    icKeyboardsettings20\n    icKeyboardShortcut\n    icKeyboardSplit\n    icKeyboardStandard\n    icKeyboardUndock\n    icKiosk\n    icKnowledgeArticle\n    icKorean\n    iclabel\n    icLandscapeOrientation\n    icLandscapeOrientationMirrored\n    icLangJPN\n    icLanguageChs\n    icLanguageCht\n    icLanguageJpn\n    icLanguageKor\n    icLaptopSecure\n    icLaptopSelected\n    icLargeErase\n    icLeaf\n    icLeaveChat\n    icLeaveChatMirrored\n    icLEDLight\n    icLeftArrowKeyTime0\n    icLeftDoubleQuote\n    icLeftQuote\n    icLeftStick\n    icLexicon\n    icLibrary\n    icLight\n    icLightbulb\n    icLightningBolt\n    icLikeChr\n    icLikeDislike\n    icLineDisplay\n    icLink\n    icList\n    icListMirrored\n    icLocaleLanguage\n    icLocation\n    icLockChr\n    icLockFeedback\n    icLockscreenDesktop\n    icLockScreenGlance\n    icLowerBrightness\n    icMagStripeReader\n    icMail\n    icMailBadge12\n    icMailFill\n    icMailForward\n    icMailForwardMirrored\n    icMailReply\n    icMailReplyAll\n    icMailReplyAllMirrored\n    icMailReplyMirrored\n    icManage\n    icMapCompassBottom\n    icMapCompassTop\n    icMapDirections\n    icMapDrive\n    icMapLayers\n    icMapPin\n    icMapPin2\n    icMarker\n    icMarket\n    icMarquee\n    icMedia\n    icMediaStorageTower\n    icMegaphone\n    icMemo\n    icMergeCall\n    icMessage\n    icMicClipping\n    icMicError\n    icMicOff\n    icMicOff2\n    icMicOn\n    icMicrophone\n    icMicrophoneListening\n    icMicrophoneSolidBold\n    icMicSleep\n    icMiniContract2Mirrored\n    icMiniExpand2Mirrored\n    icMiracastLogoLarge\n    icMiracastLogoSmall\n    icMixedMediaBadge\n    icMixVolumes\n    icMobActionCenter\n    icMobAirplane\n    icMobBattery0\n    icMobBattery1\n    icMobBattery10\n    icMobBattery2\n    icMobBattery3\n    icMobBattery4\n    icMobBattery5\n    icMobBattery6\n    icMobBattery7\n    icMobBattery8\n    icMobBattery9\n    icMobBatteryCharging0\n    icMobBatteryCharging1\n    icMobBatteryCharging10\n    icMobBatteryCharging2\n    icMobBatteryCharging3\n    icMobBatteryCharging4\n    icMobBatteryCharging5\n    icMobBatteryCharging6\n    icMobBatteryCharging7\n    icMobBatteryCharging8\n    icMobBatteryCharging9\n    icMobBatterySaver0\n    icMobBatterySaver1\n    icMobBatterySaver10\n    icMobBatterySaver2\n    icMobBatterySaver3\n    icMobBatterySaver4\n    icMobBatterySaver5\n    icMobBatterySaver6\n    icMobBatterySaver7\n    icMobBatterySaver8\n    icMobBatterySaver9\n    icMobBatteryUnknown\n    icMobBluetooth\n    icMobCallForwarding\n    icMobCallForwardingMirrored\n    icMobDrivingMode\n    icMobeSIM\n    icMobeSIMBusy\n    icMobeSIMLocked\n    icMobeSIMNoProfile\n    icMobileLocked\n    icMobileSelected\n    icMobileTablet\n    icMobLocation\n    icMobQuietHours\n    icMobSignal1\n    icMobSignal2\n    icMobSignal3\n    icMobSignal4\n    icMobSignal5\n    icMobSIMError\n    icMobSIMLock\n    icMobSIMMissing\n    icMobWifi1\n    icMobWifi2\n    icMobWifi3\n    icMobWifi4\n    icMobWifiHotspot\n    icMobWifiWarning1\n    icMobWifiWarning2\n    icMobWifiWarning3\n    icMobWifiWarning4\n    icMore\n    icMouse\n    icMoveToFolder\n    icMovies\n    icMultimediaDMP\n    icMultimediaDMS\n    icMultimediaDVR\n    icMultimediaPMP\n    icMultiSelect\n    icMultiSelectMirrored\n    icMusicAlbum\n    icMusicInfo\n    icMusicNote\n    icMusicSharing\n    icMusicSharingOff\n    icMute\n    icMyNetwork\n    icNarrator\n    icNarratorApp\n    icNarratorForward\n    icNarratorForwardMirrored\n    icNearbySharing\n    icNetwork\n    icNetworkAdapter\n    icNetworkConnected\n    icNetworkConnectedCheckmark\n    icNetworkOffline\n    icNetworkPhysical\n    icNetworkPrinter\n    icNetworkSharing\n    icNetworkTower\n    icNewFolder\n    icNewWindow\n    icNextChr\n    icNoiseCancelation\n    icNoiseCancelationOff\n    icNUIFace\n    icNUIFPContinueSlideAction\n    icNUIFPContinueSlideHand\n    icNUIFPPressAction\n    icNUIFPPressHand\n    icNUIFPPressRepeatAction\n    icNUIFPPressRepeatHand\n    icNUIFPRollLeftAction\n    icNUIFPRollLeftHand\n    icNUIFPRollRightHand\n    icNUIFPRollRightHandAction\n    icNUIFPStartSlideAction\n    icNUIFPStartSlideHand\n    icNUIIris\n    icOEM\n    icOneBar\n    icOneHandedLeft20\n    icOneHandedRight20\n    icOpenFile\n    icOpenFolderHorizontal\n    icOpenInNewWindow\n    icOpenLocal\n    icOpenPane\n    icOpenPaneMirrored\n    icOpenWith\n    icOpenWithMirrored\n    icOrientation\n    icOtherUser\n    icOutlineHalfStarLeft\n    icOutlineHalfStarRight\n    icOutlineQuarterStarLeft\n    icOutlineQuarterStarRight\n    icOutlineStarLeftHalf\n    icOutlineStarRightHalf\n    icOutlineThreeQuarterStarLeft\n    icOutlineThreeQuarterStarRight\n    icOverwriteWords\n    icOverwriteWordsFill\n    icOverwriteWordsFillKorean\n    icOverwriteWordsKorean\n    icPackage\n    icPage\n    icPageLeft\n    icPageMarginLandscapeModerate\n    icPageMarginLandscapeNarrow\n    icPageMarginLandscapeNormal\n    icPageMarginLandscapeWide\n    icPageMarginPortraitModerate\n    icPageMarginPortraitNarrow\n    icPageMarginPortraitNormal\n    icPageMarginPortraitWide\n    icPageMirrored\n    icPageRight\n    icPageSolid\n    icPaginationDotOutline10\n    icPaginationDotSolid10\n    icPanMode\n    icParkingLocation\n    icParkingLocationMirrored\n    icParkingLocationSolid\n    icPartyLeader\n    icPassiveAuthentication\n    icPasswordKeyHide\n    icPasswordKeyShow\n    icPaste\n    icPause\n    icPauseBadge12\n    icPauseBold\n    icPaymentCard\n    icPC1\n    icPDF\n    icPencil\n    icPencilFill\n    icPenPalette\n    icPenPaletteMirrored\n    icPenTips\n    icPenTipsMirrored\n    icPenWorkspace\n    icPenWorkspaceMirrored\n    icPeople\n    icPeriodKey\n    icPermissions\n    icPersonalFolder\n    icPersonalize\n    icPhone\n    icPhoneBook\n    icPhoto\n    icPhoto2\n    icPicture\n    icPieSingle\n    icPin\n    icPinFill\n    icPinned\n    icPinnedFill\n    icPINPad\n    icPinyinIMELogo\n    icPLAP\n    icPlay\n    icPlay36\n    icPlaybackRate1x\n    icPlaybackRateOther\n    icPlayBadge12\n    icPlayerSettings\n    icPlaySolid\n    icPointErase\n    icPointEraseMirrored\n    icPointerHand\n    icPoliceCar\n    icPostUpdate\n    icPowerButton\n    icPowerButtonUpdate\n    icPPSFourLandscape\n    icPPSFourPortrait\n    icPPSOneLandscape\n    icPPSOnePortrait\n    icPPSTwoLandscape\n    icPPSTwoPortrait\n    icPresenceChicklet\n    icPresenceChickletVideo\n    icPreview\n    icPreviewLink\n    icPrevious\n    icPrintChr\n    icPrintAllPages\n    icPrintCustomRange\n    icPrintDefault\n    icPrinter3D\n    icPrintfaxPrinterFile\n    icPriority\n    icPrivateCall\n    icProcess\n    icProcessing\n    icProductivityMode\n    icProgressRingDots\n    icProject\n    icProjector\n    icProtectedDocument\n    icProtractor\n    icProvisioningPackage\n    icPuncKey\n    icPuncKey0\n    icPuncKey1\n    icPuncKey2\n    icPuncKey3\n    icPuncKey4\n    icPuncKey5\n    icPuncKey6\n    icPuncKey7\n    icPuncKey8\n    icPuncKey9\n    icPuncKeyLeftBottom\n    icPuncKeyRightBottom\n    icPuzzle\n    icQRCode\n    icQuarentinedItems\n    icQuarentinedItemsMirrored\n    icQuarterStarLeft\n    icQuarterStarRight\n    icQuickNote\n    icQuietHours\n    icQuietHoursBadge12\n    icQWERTYOff\n    icQWERTYOn\n    icRadar\n    icRadioBtnOff\n    icRadioBtnOn\n    icRadioBullet\n    icRadioBullet2\n    icRead\n    icReadingList\n    icReadingMode\n    icReceiptPrinter\n    icRecent\n    icRecord\n    icRecord2\n    icRectangularClipping\n    icRedEye\n    icRedo\n    icRefresh\n    icRelationship\n    icRememberedDevice\n    icReminder\n    icReminderFill\n    icRemote\n    icRemove\n    icRemoveFrom\n    icRename\n    icRepair\n    icRepeatAll\n    icRepeatOff\n    icRepeatOne\n    icReplay\n    icReply\n    icReplyMirrored\n    icReportDocument\n    icReportHacked\n    icResetDevice\n    icResetDrive\n    icReshare\n    icResizeMouseLarge\n    icResizeMouseMedium\n    icResizeMouseMediumMirrored\n    icResizeMouseSmall\n    icResizeMouseSmallMirrored\n    icResizeMouseTall\n    icResizeMouseTallMirrored\n    icResizeMouseWide\n    icResizeTouchLarger\n    icResizeTouchNarrower\n    icResizeTouchNarrowerMirrored\n    icResizeTouchShorter\n    icResizeTouchSmaller\n    icRestartUpdate\n    icReturnKey\n    icReturnKeyLg\n    icReturnKeySm\n    icReturnToCall\n    icReturnToWindow\n    icRevealPasswordMedium\n    icRevToggleKey\n    icRewind\n    icRightArrowKeyTime0\n    icRightArrowKeyTime1\n    icRightArrowKeyTime2\n    icRightArrowKeyTime3\n    icRightArrowKeyTime4\n    icRightDoubleQuote\n    icRightQuote\n    icRightStick\n    icRinger\n    icRingerBadge12\n    icRingerSilent\n    icRoamingDomestic\n    icRoamingInternational\n    icRobot\n    icRotate\n    icRotateCamera\n    icRotateMapLeft\n    icRotateMapRight\n    icRotationLock\n    icRTTLogo\n    icRuler\n    icSafe\n    icSave\n    icSaveAs\n    icSaveCopy\n    icSaveLocal\n    icScan\n    icScreenTime\n    icScrollMode\n    icScrollUpDown\n    icSDCard\n    icSearch\n    icSearchAndApps\n    icSearchMedium\n    icSelectAll\n    icSend\n    icSendFill\n    icSendFillMirrored\n    icSendMirrored\n    icSensor\n    icSetChr\n    icSetHistoryStatus\n    icSetHistoryStatus2\n    icSetlockScreen\n    icSetSolid\n    icSetTile\n    icSetting\n    icSettingsBattery\n    icSettingsDisplaySound\n    icSettingsSolid\n    icShare\n    icShareBroadband\n    icShield\n    icShop\n    icShoppingCart\n    icShowBcc\n    icShowResults\n    icShowResultsMirrored\n    icShuffle\n    icSignalBars1\n    icSignalBars2\n    icSignalBars3\n    icSignalBars4\n    icSignalBars5\n    icSignalError\n    icSignalNotConnected\n    icSignalRoaming\n    icSignatureCapture\n    icSignOut\n    icSIMError\n    icSIMLock\n    icSIMMissing\n    icSingleLandscape\n    icSinglePortrait\n    icSIPMove\n    icSIPRedock\n    icSIPUndock\n    icSkipBack10\n    icSkipForward30\n    icSliderThumb\n    icSlideshow\n    icSlowMotionOn\n    icSmallErase\n    icSmartcard\n    icSmartcardVirtual\n    icSmartScreen\n    icSort\n    icSpatialVolume0\n    icSpatialVolume1\n    icSpatialVolume2\n    icSpatialVolume3\n    icSpeakers\n    icSpecialEffectSize\n    icSpeech\n    icSpeechSolidBold\n    icSpeedHigh\n    icSpeedMedium\n    icSpeedOff\n    icSpelling\n    icSpellingChinese\n    icSpellingKorean\n    icSpellingSerbian\n    icSplit20\n    icStaplingLandscapeBookBinding\n    icStaplingLandscapeBottomLeft\n    icStaplingLandscapeBottomRight\n    icStaplingLandscapeTopLeft\n    icStaplingLandscapeTopRight\n    icStaplingLandscapeTwoBottom\n    icStaplingLandscapeTwoLeft\n    icStaplingLandscapeTwoRight\n    icStaplingLandscapeTwoTop\n    icStaplingOff\n    icStaplingPortraitBookBinding\n    icStaplingPortraitBottomLeft\n    icStaplingPortraitBottomRight\n    icStaplingPortraitTopLeft\n    icStaplingPortraitTopRight\n    icStaplingPortraitTwoBottom\n    icStaplingPortraitTwoLeft\n    icStaplingPortraitTwoRight\n    icStaplingPortraitTwoTop\n    icStartPoint\n    icStartPointSolid\n    icStartPresenting\n    icStatusCheckmark\n    icStatusCheckmark7\n    icStatusCheckmarkLeft\n    icStatusCircle\n    icStatusCircle7\n    icStatusCircleBlock\n    icStatusCircleBlock2\n    icStatusCircleCheckmark\n    icStatusCircleErrorX\n    icStatusCircleExclamation\n    icStatusCircleInfo\n    icStatusCircleInner\n    icStatusCircleLeft\n    icStatusCircleOuter\n    icStatusCircleQuestionMark\n    icStatusCircleRing\n    icStatusCircleSync\n    icStatusConnecting1\n    icStatusConnecting2\n    icStatusDataTransfer\n    icStatusDataTransferRoaming\n    icStatusDataTransferVPN\n    icStatusDualSIM1\n    icStatusDualSIM1VPN\n    icStatusDualSIM2\n    icStatusDualSIM2VPN\n    icStatusError\n    icStatusErrorCircle7\n    icStatusErrorFull\n    icStatusErrorLeft\n    icStatusExclamationCircle7\n    icStatusInfo\n    icStatusInfoLeft\n    icStatusPause7\n    icStatusSecured\n    icStatusSGLTE\n    icStatusSGLTECell\n    icStatusSGLTEDataVPN\n    icStatusTriangle\n    icStatusTriangleExclamation\n    icStatusTriangleInner\n    icStatusTriangleLeft\n    icStatusTriangleOuter\n    icStatusUnsecure\n    icStatusVPN\n    icStatusWarning\n    icStatusWarningLeft\n    icSticker2\n    icStockDown\n    icStockUp\n    icStopChr\n    icStopPoint\n    icStopPointSolid\n    icStopPresenting\n    icStopwatch\n    icStorageNetworkWireless\n    icStorageOptical\n    icStorageTape\n    icStreaming\n    icStreamingEnterprise\n    icStreet\n    icStreetsideSplitExpand\n    icStreetsideSplitMinimize\n    icStrikethrough\n    icStrokeErase\n    icStrokeErase2\n    icStrokeEraseMirrored\n    icSubscriptionAdd\n    icSubscriptionAddMirrored\n    icSubtitles\n    icSubtitlesAudio\n    icSubtractBold\n    icSurfaceHub\n    icSurfaceHubSelected\n    icSustainable\n    icSwipe\n    icSwipeRevealArt\n    icSwitch\n    icSwitchApps\n    icSwitchUser\n    icSync\n    icSyncBadge12\n    icSyncError\n    icSyncFolder\n    icSystem\n    icTablet\n    icTabletMode\n    icTabletSelected\n    icTag\n    icTapAndSend\n    icTaskbarPhone\n    icTaskView\n    icTaskViewExpanded\n    icTaskViewSettings\n    icThisPC\n    icThoughtBubble\n    icThreeBars\n    icThreeQuarterStarLeft\n    icThreeQuarterStarRight\n    icTiles\n    icTiltDown\n    icTiltUp\n    icTimeLanguage\n    icToggleBorder\n    icToggleFilled\n    icToggleLeft\n    icToggleRight\n    icToggleThumb\n    icTollSolid\n    icToolTip\n    icTouch\n    icTouchpad\n    icTouchPointer\n    icTouchscreen\n    icTrackers\n    icTrackersMirrored\n    icTrafficCongestionSolid\n    icTrafficLight\n    icTrain\n    icTrainSolid\n    icTreeFolderFolder\n    icTreeFolderFolderFill\n    icTreeFolderFolderOpen\n    icTreeFolderFolderOpenFill\n    icTriggerLeft\n    icTriggerRight\n    icTrim\n    icTVMonitor\n    icTVMonitorSelected\n    icTwoBars\n    icTwoPage\n    icTypeChr\n    icUnderline\n    icUnderscoreSpace\n    icUndo\n    icUnfavorite\n    icUnit\n    icUnknown\n    icUnknownMirrored\n    icUnlockChr\n    icUnpin\n    icUnsyncFolder\n    icUp\n    icUpArrowShiftKey\n    icUpdateRestore\n    icUpdateStatusDot\n    icUpload\n    icUpShiftKey\n    icUSB\n    icUSBSafeConnect\n    icUserAPN\n    icVerticalBattery0\n    icVerticalBattery1\n    icVerticalBattery10\n    icVerticalBattery2\n    icVerticalBattery3\n    icVerticalBattery4\n    icVerticalBattery5\n    icVerticalBattery6\n    icVerticalBattery7\n    icVerticalBattery8\n    icVerticalBattery9\n    icVerticalBatteryCharging0\n    icVerticalBatteryCharging1\n    icVerticalBatteryCharging10\n    icVerticalBatteryCharging2\n    icVerticalBatteryCharging3\n    icVerticalBatteryCharging4\n    icVerticalBatteryCharging5\n    icVerticalBatteryCharging6\n    icVerticalBatteryCharging7\n    icVerticalBatteryCharging8\n    icVerticalBatteryCharging9\n    icVerticalBatteryUnknown\n    icVibrate\n    icVideo\n    icVideo360\n    icVideoCapture\n    icVideoChat\n    icVideoSolid\n    icView\n    icViewAll\n    icViewDashboard\n    icVirtualMachineGroup\n    icVoiceCall\n    icVolume\n    icVolume0\n    icVolume1\n    icVolume2\n    icVolume3\n    icVolumeBars\n    icVPN\n    icWalk\n    icWalkSolid\n    icWarning\n    icWebcam\n    icWebcam2\n    icWebSearch\n    icWebsite\n    icWheel\n    icWifi\n    icWifi1\n    icWifi2\n    icWifi3\n    icWifiAttentionOverlay\n    icWifiCall0Chr\n    icWifiCall0\n    icWifiCall1Chr\n    icWifiCall1\n    icWifiCall2Chr\n    icWifiCall2\n    icWifiCall3Chr\n    icWifiCall3\n    icWifiCall4Chr\n    icWifiCall4\n    icWifiCallBarsChr\n    icWifiCallBars\n    icWifiError0\n    icWifiError1\n    icWifiError2\n    icWifiError3\n    icWifiError4\n    icWifiEthernet\n    icWifiHotspot\n    icWifiWarning0\n    icWifiWarning1\n    icWifiWarning2\n    icWifiWarning3\n    icWifiWarning4\n    icWindDirection\n    icWindowsInsider\n    icWindowSnipping\n    icWire\n    icWiredUSB\n    icWirelessUSB\n    icWork\n    icWorkSolid\n    icWorld\n    icXboxOneConsole\n    icZeroBars\n    icZoom\n    icZoomIn\n    icZoomMode\n    icZoomOut\n    [_First] = icAccept\n    [_Last] = icZoomOut\nEnd Enum\n\nPrivate Enum colNameEnum\n    NameIcon = 1\n    CodeIcon\n    CharIcon\nEnd Enum\n\nPublic Function getIcon(ByVal codIcon As IconEnums) As String\n    getIcon = VBA.ChrW$(getIconCode(codIcon))\nEnd Function\n\nPublic Function getIconCode(ByVal codIcon As IconEnums) As Long\n    getIconCode = getIconCodeOrName(codIcon, colNameEnum.CodeIcon)\nEnd Function\n\nPublic Function getIconName(ByVal codIcon As IconEnums) As String\n    getIconName = getIconCodeOrName(codIcon, colNameEnum.NameIcon)\nEnd Function\n\nPublic Function getAllIconsArray() As Variant\n    Dim sh          As Worksheet\n    Const SH_NAME   As String = \"ICON\"\n    If HaveSheetInFile(ThisWorkbook, SH_NAME) Then\n        Set sh = ThisWorkbook.Worksheets(SH_NAME)\n    Else\n        If wbIsOpen(\"MACROTools.xlam\") Then\n            Dim arr As Variant\n            arr = Workbooks(\"MACROTools.xlam\").Worksheets(\"SHSNIPPETS\").ListObjects(TB_ICON).Range.Value2\n            Set sh = ThisWorkbook.Worksheets.Add\n            With sh\n                .Name = SH_NAME\n                .Cells(1, 1).Resize(UBound(arr, 1), UBound(arr, 2)).Value2 = arr\n                With .ListObjects.Add(xlSrcRange, .Cells(1, 1).Resize(UBound(arr, 1), UBound(arr, 2)), , xlYes)\n                    .Name = TB_ICON\n                    With .ListColumns(3).DataBodyRange\n                        .Font.Name = \"Segoe MDL2 Assets\"\n                        .HorizontalAlignment = xlCenter\n                    End With\n                End With\n                .Columns(1).EntireColumn.AutoFit\n                .Columns(2).EntireColumn.AutoFit\n                .Columns(3).EntireColumn.AutoFit\n            End With\n        Else\n            getAllIconsArray = -1\n            Exit Function\n        End If\n    End If\n\n    With sh.ListObjects(TB_ICON)\n        If Not .DataBodyRange Is Nothing Then getAllIconsArray = .DataBodyRange.Value2\n    End With\nEnd Function\n\nPrivate Function HaveSheetInFile(ByRef wb As Workbook, ByVal SHName As String) As Boolean\n    Dim sh          As Worksheet\n    On Error Resume Next\n    Set sh = wb.Worksheets(SHName)\n    HaveSheetInFile = Err.Number = 0\n    Err.Clear\nEnd Function\n\nPrivate Function wbIsOpen(ByVal sNameWb As String) As Boolean\n    On Error Resume Next\n    Dim wb          As Workbook\n    Set wb = Workbooks(sNameWb)\n    wbIsOpen = Err.Number = 0\n    Err.Clear\nEnd Function\n\nPrivate Function getIconCodeOrName(ByVal codIcon As IconEnums, ByVal iCol As colNameEnum) As Variant\n    Select Case codIcon\n        Case Is < IconEnums.[_First]:\n            Err.Raise Number:=vbObjectError + 1, Description:=\"The codIcon can't be less than: [ \" & IconEnums.[_First] & \" ], your value [ \" & codIcon & \" ]\"\n        Case Is > IconEnums.[_Last]:\n            Err.Raise Number:=vbObjectError + 2, Description:=\"The codIcon can't be more than: [ \" & IconEnums.[_Last] & \" ], your value [ \" & codIcon & \" ]\"\n        Case Else:\n            Dim arrIcon As Variant\n            arrIcon = getAllIconsArray()\n            If IsArray(arrIcon) Then\n                getIconCodeOrName = arrIcon(codIcon, iCol)\n            ElseIf arrIcon = -1 Then\n                Err.Raise Number:=vbObjectError + 3, Description:=\"The source of the icon array was not found\"\n            End If\n    End Select\nEnd Function"
    }, 
    {
      "CODE_GRUP": "FSO", 
      "CODE_SNIPPET": "delPath", 
      "CODE": "Public Sub delPath(ByVal sPath As String)\r\n    Dim objFso      As Object\r\n    Set objFso = CreateObject(\"Scripting.FileSystemObject\")\r\n    objFso.GetFolder(sPath).Delete\r\n    Set objFso = Nothing\r\nEnd Sub", 
      "DISCRIPTION": "Удалить папку"
    }, 
    {
      "CODE_GRUP": "FSO", 
      "CODE_SNIPPET": "MoveFile", 
      "CODE": "Public Function MoveFile(OldFile As String, NewPathFile As String) As Boolean\r\n    'Перемещение файлов\r\n    Dim objFso As Object, objFile As Object\r\n    If Dir(OldFile, 16) = vbNullString Then Exit Function\r\n    'перемещаем файл\r\n    Set objFso = CreateObject(\"Scripting.FileSystemObject\"): Set objFile = objFso.GetFile(OldFile)\r\n    objFile.Copy NewPathFile\r\n    Set objFile = Nothing: Set objFso = Nothing\r\n    MoveFile = True\r\nEnd Function", 
      "DISCRIPTION": "Переместить файл из одной папки в другую"
    }, 
    {
      "CODE_GRUP": "FSO", 
      "CODE_SNIPPET": "sFileExists", 
      "CODE": "Public Function sFileExists(ByVal sPathFile As String) As Boolean\r\n    'sPathFile - строка, путь.\r\n    'возвращает True, если указанный файл сущесвтвует, и False в противном случае.\r\n    Dim FSO As Object\r\n    Set FSO = CreateObject(\"Scripting.FileSystemObject\")\r\n    sFileExists = FSO.FileExists(sPathFile)\r\n    Set FSO = Nothing\r\nEnd Function", 
      "DISCRIPTION": "Возвращает True, если указанный файл сущесвтвует, и False в противном случае"
    }, 
    {
      "CODE_GRUP": "FSO", 
      "CODE_SNIPPET": "sFolderExists", 
      "CODE": "Public Function sFolderExists(ByVal sPathFile As String) As Boolean\r\r\n    'sPathFile - строка, путь.\r\r\n    'возвращает True, если указанный каталог сущесвтвует, и False в противном случае.\r\r\n    Dim FSO As Object\r\r\n    Set FSO = CreateObject(\"Scripting.FileSystemObject\")\r\r\n    sFolderExists = FSO.FolderExists(sPathFile)\r\r\n    Set FSO = Nothing\r\nEnd Function", 
      "DISCRIPTION": "Возвращает True, если указанный каталог сущесвтвует, и False в противном случае."
    }, 
    {
      "CODE_GRUP": "FSO", 
      "CODE_SNIPPET": "sGetBaseName", 
      "CODE": "Public Function sGetBaseName(ByVal sPathFile As String) As String\r\n    'sPathFile - строка, путь.\r\n    'возвращает имя (без расширения) последнего компонента в заданном пути.\r\n    Dim FSO         As Object\r\n    Set FSO = CreateObject(\"Scripting.FileSystemObject\")\r\n    sGetBaseName = FSO.GetBaseName(sPathFile)\r\n    Set FSO = Nothing\r\nEnd Function", 
      "DISCRIPTION": "Возвращает имя (без расширения) последнего компонента в заданном пути"
    }, 
    {
      "CODE_GRUP": "FSO", 
      "CODE_SNIPPET": "sGetExtensionName", 
      "CODE": "Public Function sGetExtensionName(ByVal sPathFile As String) As String\r\n    'sPathFile - строка, путь.\r\n    'возвращает расширение последнего компонента в заданном пути.\r\n    Dim FSO         As Object\r\n    Set FSO = CreateObject(\"Scripting.FileSystemObject\")\r\n    sGetExtensionName = FSO.GetExtensionName(sPathFile)\r\n    Set FSO = Nothing\r\nEnd Function", 
      "DISCRIPTION": "Возвращает расширение последнего компонента в заданном пути"
    }, 
    {
      "CODE_GRUP": "FSO", 
      "CODE_SNIPPET": "sGetFileName", 
      "CODE": "Public Function sGetFileName(ByVal sPathFile As String) As String\r\n    'sPathFile - строка, путь.\r\n    'возвращает имя (с расширением) последнего компонента в заданном пути.\r\n    Dim FSO         As Object\r\n    Set FSO = CreateObject(\"Scripting.FileSystemObject\")\r\n    sGetFileName = FSO.GetFileName(sPathFile)\r\n    Set FSO = Nothing\r\nEnd Function", 
      "DISCRIPTION": "Возвращает имя (с расширением) последнего компонента в заданном пути"
    }, 
    {
      "CODE_GRUP": "FSO", 
      "CODE_SNIPPET": "sGetParentFolderName", 
      "CODE": "Public Function sGetParentFolderName(ByVal sPathFile As String) As String\r\n    'sPathFile - строка, путь.\r\n    'возвращает путь к последнему компоненту в заданном пути (его каталог).\r\n    Dim FSO As Object\r\n    Set FSO = CreateObject(\"Scripting.FileSystemObject\")\r\n    sGetParentFolderName = FSO.GetParentFolderName(sPathFile)\r\n    Set FSO = Nothing\r\nEnd Function", 
      "DISCRIPTION": "Возвращает путь к последнему компоненту в заданном пути (его каталог)"
    }, 
    {
      "CODE_GRUP": "FSO", 
      "CODE_SNIPPET": "sGetTempName", 
      "CODE": "Public Function sGetTempName() As String\r\n    'sPathFile - строка, путь.\r\n    'возвращает случайным образом сгенерированное имя файла, которое может быть использовано для создания временного файла.\r\n    Dim FSO As Object\r\n    Set FSO = CreateObject(\"Scripting.FileSystemObject\")\r\n    sGetTempName = FSO.GetTempName()\r\n    Set FSO = Nothing\r\nEnd Function", 
      "DISCRIPTION": "Возвращает случайным образом сгенерированное имя файла, которое может быть использовано для создания временного файла"
    }, 
    {
      "CODE_GRUP": "Http", 
      "CODE_SNIPPET": "responseTextHttp", 
      "CODE": "Private Function responseTextHttp(ByVal URL As String, Optional sToken As String = vbNullString, Optional sSend As String = vbNullString) As String\r\n    Dim oHttp       As Object\r\n    On Error Resume Next\r\n    Set oHttp = CreateObject(\"MSXML2.XMLHTTP\")\r\n    If Err.Number <> 0 Then\r\n        Set oHttp = CreateObject(\"MSXML.XMLHTTPRequest\")\r\n    End If\r\n    On Error GoTo 0\r\n    If oHttp Is Nothing Then\r\n        responseTextHttp = vbNullString\r\n        Exit Function\r\n    End If\r\n\r\n    With oHttp\r\n        .Open \"POST\", URL, False    '\"GET\"\r\n        .setRequestHeader \"User-Agent\", \"Mozilla/5.0 (Windows NT 6.1; WOW64; Trident/7.0; rv:11.0) like Gecko\"\r\n        '.SetRequestHeader \"Authorization\", \"Bearer \" & sToken\r\n        \r\n        '.SetRequestHeader \"Content-Type\", \"text/xml; charset=utf-8\"\r\n        '.SetRequestHeader \"Content-Type\", \"application/json\"\r\n        '.setRequestHeader \"Content-Type\", \"application/xml\"\r\n        \r\n        '.SetRequestHeader \"Content-Charset\", \"UTF-8\"\r\n        \r\n        ' if use proxy\r\n        ' .setProxy 2, \"192.168.100.1:3128\"\r\n        ' .setProxyCredentials \"user\", \"password\"\r\n        \r\n        .send (sSend)\r\n        If .Status <> 200 Then\r\n            Call MsgBox(\"Error\" & vbNewLine & \"Status: \" & .Status & \" Text: \" & .responseText, vbCritical, \"Error:\")\r\n        End If\r\n        responseTextHttp = .responseText\r\n    End With\r\n    Set oHttp = Nothing\r\nEnd Function", 
      "DISCRIPTION": "HTTP запрос на сайт"
    }, 
    {
      "CODE_GRUP": "Http", 
      "CODE_SNIPPET": "webPageHTML", 
      "CODE": "Public Function webPageHTML(ByVal sURL As String) As String\r\n    ' создаём объект IE\r\n    Dim IE          As Object\r\n    Set IE = CreateObject(\"InternetExplorer.Application\")\r\n    ' переходим по ссылке в браузере\r\n    IE.Navigate sURL\r\n    ' ждём, пока страница загрузиться\r\n    While IE.Busy Or (IE.ReadyState <> 4): DoEvents: Wend\r\n    ' считываем HTML код веб-страницы в текстовую переменную\r\n    webPageHTML = IE.Document.body.innerHtml\r\nEnd Function\r\n", 
      "DISCRIPTION": "Получение HTML страницы по URL"
    }, 
    {
      "CODE_GRUP": "Http", 
      "CODE_SNIPPET": "webPageText", 
      "CODE": "Public Function webPageText(ByVal sURL As String) As String\r\n    On Error Resume Next\r\n    Dim IE          As Object\r\n    ' загружаем браузер Internet Explorer\r\n    Set IE = CreateObject(\"InternetExplorer.Application\"):\r\n    IE.Navigate sURL    ' загружаем сайт\r\n    ' ждем, пока загрузится страница\r\n    While IE.Busy Or (IE.ReadyState <> 4): DoEvents: Wend\r\n    ' считываем текст веб-страницы\r\n    webPageText = IE.Document.body.innerText\r\n    ' закрываем браузер\r\n    IE.Quit: Set IE = Nothing\r\nEnd Function", 
      "DISCRIPTION": "Получение текста с HTML страницы по URL"
    }, 
    {
      "CODE_GRUP": "Iff", 
      "CODE_SNIPPET": "IfEl", 
      "CODE": "If @1 Then\r\n          \r\nElse\r\n    \r\nEnd If", 
      "DISCRIPTION": "Условие IF Else"
    }, 
    {
      "CODE_GRUP": "Iff", 
      "CODE_SNIPPET": "IfEn", 
      "CODE": "If  @1  then\r\n    \r\nEnd If", 
      "DISCRIPTION": "Условие IF "
    }, 
    {
      "CODE_GRUP": "Iff", 
      "CODE_SNIPPET": "SeCa", 
      "CODE": "Select Case @1\r\r\n    Case\r\r\n    \r\r\nEnd Select", 
      "DISCRIPTION": "Условие Select Cas"
    }, 
    {
      "CODE_GRUP": "LogFile", 
      "CODE_SNIPPET": "ShowLog", 
      "clsLogging.cls": "\n'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\n'* Class        :   clsLogging - High-performance CSV logger with Unicode support\n'* Author       :   VBATools\n'* Copyright    :   Apache License\n'* Version      :   2.0\n'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\n\n'---------------------------------------------------------------------------------------------------\n' ENUMERATIONS\n'---------------------------------------------------------------------------------------------------\nPublic Enum LOG_LEVEL\n    LOG_LEVEL_INFO = 0\n    LOG_LEVEL_WARNING = 1\n    LOG_LEVEL_ERROR = 2\nEnd Enum\n\n'---------------------------------------------------------------------------------------------------\n' CONSTANTS\n'---------------------------------------------------------------------------------------------------\nPrivate Const CLASS_NAME As String = \"clsLogging\"\n\n' Log file configuration\nPrivate Const DEFAULT_LOG_EXTENSION As String = \".csv\"\nPrivate Const DEFAULT_LOG_FILENAME As String = NAME_ADDIN & \"_logs\"\n\n' CSV configuration\nPrivate Const CSV_DELIMITER As String = \";\"\nPrivate Const CSV_HEADER As String = \"Timestamp\" & CSV_DELIMITER & \"Level\" & CSV_DELIMITER & \"Event\" & CSV_DELIMITER & \"Info\"\nPrivate Const QUOTE_CHAR As String = \"\"\"\"\n\n' FSO constants\nPrivate Const FSO_FOR_APPENDING As Integer = 8\nPrivate Const FSO_TRISTATE_TRUE As Long = -1\n\n' Buffer defaults\nPrivate Const DEFAULT_BUFFER_SIZE As Long = 5000\nPrivate Const MAX_MESSAGE_LENGTH As Long = 1000\n\n'---------------------------------------------------------------------------------------------------\n' MEMBER VARIABLES\n'---------------------------------------------------------------------------------------------------\nPrivate m_FSO As Object\nPrivate m_WorkbookPath As String\nPrivate m_LogFilePath As String\nPrivate m_Buffer As Collection\nPrivate m_MaxBufferSize As Long\n\n'===================================================================================================\n' PROPERTIES\n'===================================================================================================\n\n' Возвращает полный путь к файлу лога\nPublic Property Get FilePathLog() As String\n    FilePathLog = m_LogFilePath\nEnd Property\n\n' Устанавливает имя файла лога (без расширения)\nPublic Property Let FileNameLog(ByVal FileName As String)\n    Dim sName As String\n    \n    sName = Trim$(FileName)\n    If Len(sName) = 0 Then\n        sName = DEFAULT_LOG_FILENAME\n    End If\n    \n    m_LogFilePath = m_WorkbookPath & sName & DEFAULT_LOG_EXTENSION\nEnd Property\n\n' Устанавливает размер буфера перед принудительной записью\nPublic Property Let MaxBufferSize(ByVal Size As Long)\n    \n    Select Case Size\n        Case 0: m_MaxBufferSize = DEFAULT_BUFFER_SIZE\n        Case Is > 0:  m_MaxBufferSize = Size\n        Case Else: Err.Raise 5, CLASS_NAME & \".MaxBufferSize\", \"Buffer size must be greater than zero.\"\n    End Select\n\nEnd Property\n\n'===================================================================================================\n' INITIALIZATION / TERMINATION\n'===================================================================================================\n\nPrivate Sub Class_Initialize()\n    On Error GoTo ErrorHandler\n    \n    Set m_FSO = CreateObject(\"Scripting.FileSystemObject\")\n    Set m_Buffer = New Collection\n    \n    m_WorkbookPath = ThisWorkbook.Path & Application.PathSeparator\n\n    \n    Me.FileNameLog = DEFAULT_LOG_FILENAME\n    Exit Sub\n    \nErrorHandler:\n    Err.Raise Err.Number, CLASS_NAME & \".Class_Initialize\", _\n              \"Failed to initialize logger: \" & Err.Description\nEnd Sub\n\nPrivate Sub Class_Terminate()\n    ' Принудительно сохраняем буфер при уничтожении объекта\n    If Not m_Buffer Is Nothing Then\n        If m_Buffer.Count > 0 Then Call FlushBuffer\n        Set m_Buffer = Nothing\n    End If\n    Set m_FSO = Nothing\nEnd Sub\n\n'===================================================================================================\n' PUBLIC API\n'===================================================================================================\n\n' Логирование информационного сообщения\nPublic Sub LogInfo(ByVal EventX As String, Optional ByVal Info As String)\n    Call AddRecord(EventX, Info, LOG_LEVEL_INFO)\nEnd Sub\n\n' Логирование предупреждения\nPublic Sub LogWarning(ByVal EventX As String, Optional ByVal Info As String)\n    Call AddRecord(EventX, Info, LOG_LEVEL_WARNING)\nEnd Sub\n\n' Логирование ошибки с информацией из глобального объекта Err\nPublic Sub LogError(Optional ByVal FunctionName As String)\n    Dim sContext As String\n    \n    If Len(Trim$(FunctionName)) = 0 Then FunctionName = \"Unknown Procedure\"\n    \n    sContext = \"Err #\" & Err.Number & _\n               \" | Line: \" & Erl & _\n               \" | Description: \" & Err.Description\n    \n    Call AddRecord(FunctionName, sContext, LOG_LEVEL_ERROR, True)\nEnd Sub\n\n'===================================================================================================\n' CORE LOGIC\n'===================================================================================================\n\n' Основной метод добавления записи\nPublic Sub AddRecord( _\n    ByVal EventX As String, _\n    Optional ByVal Info As String, _\n    Optional ByVal Level As LOG_LEVEL = LOG_LEVEL_INFO, _\n    Optional ByVal ForceSave As Boolean = False)\n    \n    ' Валидация входных данных\n    Call ValidateInput(EventX, \"EventX\")\n    If IsMissing(Info) Then Info = vbNullString\n    \n    Dim sLevelTag As String\n    Dim csvLine As String\n    \n    ' Определение текстового уровня\n    sLevelTag = Choose(Level + 1, \"INFO\", \"WARNING\", \"ERROR\")\n    If Len(sLevelTag) = 0 Then sLevelTag = \"INFO\"\n    \n    ' Формирование CSV-строки\n    csvLine = EscapeCSV(Format$(Now, \"yyyy-mm-dd hh:nn:ss\")) & CSV_DELIMITER & _\n              EscapeCSV(sLevelTag) & CSV_DELIMITER & _\n              EscapeCSV(EventX) & CSV_DELIMITER & _\n              EscapeCSV(Info)\n    \n    ' Добавление в буфер (Collection вместо конкатенации)\n    m_Buffer.Add csvLine\n    \n    ' Проверка условий для записи на диск\n    If ForceSave Or (m_Buffer.Count >= m_MaxBufferSize) Then\n        Call FlushBuffer\n    End If\nEnd Sub\n\n' Принудительная запись буфера в файл\nPublic Sub FlushBuffer()\n    If m_Buffer.Count = 0 Then Exit Sub\n    \n    Dim sContent As String\n    Dim vItem As Variant\n    \n    ' Сборка буфера в одну строку\n    For Each vItem In m_Buffer\n        sContent = sContent & vItem & vbNewLine\n    Next vItem\n    \n    ' Запись и очистка\n    If AppendToFile(sContent) Then\n        Call ClearBuffer\n    Else\n        Call MsgBox(\"CRITICAL: Failed to write log buffer to \" & m_LogFilePath, vbCritical)\n    End If\nEnd Sub\n\n' Открытие лога во внешнем приложении\nPublic Sub ShowLog()\n    If Not m_FSO.FileExists(m_LogFilePath) Then\n        Call MsgBox(\"Log file does not exist\", vbInformation, NAME_ADDIN)\n        Exit Sub\n    End If\n    \n    On Error Resume Next\n    Call CreateObject(\"WScript.Shell\").Run(\"\"\"\" & m_LogFilePath & \"\"\"\")\n    On Error GoTo 0\nEnd Sub\n\n' Удаление лог-файла\nPublic Sub ResetLogs()\n    If Not m_FSO.FileExists(m_LogFilePath) Then\n        Call MsgBox(\"Log file not found.\", vbInformation, NAME_ADDIN)\n        Exit Sub\n    End If\n    \n    On Error Resume Next\n    Call m_FSO.DeleteFile(m_LogFilePath, True)\n    \n    If Err.Number = 0 Then\n        Call ClearBuffer\n        Call MsgBox(\"Log successfully cleared.\", vbInformation, NAME_ADDIN)\n    Else\n        Call MsgBox(\"Error deleting log:\" & Err.Description, vbExclamation, NAME_ADDIN)\n    End If\n    On Error GoTo 0\nEnd Sub\n\n'===================================================================================================\n' PRIVATE HELPERS\n'===================================================================================================\n\n' Очистка буфера\nPrivate Sub ClearBuffer()\n    Do While m_Buffer.Count > 0\n        m_Buffer.Remove 1\n    Loop\nEnd Sub\n\n' Экранирование спецсимволов для CSV\nPrivate Function EscapeCSV(ByVal txt As String) As String\n    Dim needsQuotes As Boolean\n    \n    ' Проверка на необходимость кавычек\n    needsQuotes = InStr(txt, CSV_DELIMITER) > 0 Or _\n                  InStr(txt, vbCr) > 0 Or _\n                  InStr(txt, vbLf) > 0 Or _\n                  InStr(txt, QUOTE_CHAR) > 0\n    \n    ' Удваивание кавычек (стандарт CSV RFC 4180)\n    txt = Replace$(txt, QUOTE_CHAR, QUOTE_CHAR & QUOTE_CHAR)\n    \n    If needsQuotes Then\n        EscapeCSV = QUOTE_CHAR & txt & QUOTE_CHAR\n    Else\n        EscapeCSV = txt\n    End If\nEnd Function\n\n' Дозапись в файл\nPrivate Function AppendToFile(ByVal text As String, Optional ByVal FilePath As String) As Boolean\n    Dim ts As Object\n    Dim targetPath As String\n    Dim bIsNewFile As Boolean\n    \n    On Error GoTo ErrorHandler\n    \n    targetPath = IIf(Len(FilePath) = 0, m_LogFilePath, FilePath)\n    bIsNewFile = Not m_FSO.FileExists(targetPath)\n    \n    Set ts = m_FSO.OpenTextFile(targetPath, FSO_FOR_APPENDING, True, FSO_TRISTATE_TRUE)\n    \n    With ts\n        If bIsNewFile Then Call .Write(CSV_HEADER & vbNewLine)\n        Call .Write(text)\n        .Close\n    End With\n    \n    AppendToFile = True\n    Set ts = Nothing\n    Exit Function\n    \nErrorHandler:\n    Debug.Print \"Error writing to log file [\" & targetPath & \"]: \" & Err.Description\n    AppendToFile = False\n    Set ts = Nothing\nEnd Function\n\n' Валидация входных параметров\nPrivate Sub ValidateInput(ByVal value As String, ByVal ParamName As String)\n    If Len(Trim$(value)) = 0 Then\n        Err.Raise 5, CLASS_NAME & \".\" & ParamName, \"Parameter cannot be empty or whitespace.\"\n    End If\n    \n    If Len(value) > MAX_MESSAGE_LENGTH Then\n        Err.Raise 5, CLASS_NAME & \".\" & ParamName, _\n              \"Parameter exceeds maximum length of \" & MAX_MESSAGE_LENGTH & \" characters.\"\n    End If\nEnd Sub", 
      "CODE": "Public Sub ShowLog()\r\n    'ShowLog - показывает Log файл\r\n    Dim LR     As LogRecorder\r\n    Set LR = New LogRecorder\r\n    \r\n    'Именить название Log файла, по умолчанию \"common\"\r\n    'LR.LogFileName = \"NewNameFileLog\"\r\n    \r\n    'False - покать в блокноте, True - в окне Immediate\r\n    Call LR.ShowLog(True)\r\nEnd Sub", 
      "DISCRIPTION": "Показать лог файл для класса LogRecorder"
    }, 
    {
      "CODE_GRUP": "LogFile", 
      "CODE_SNIPPET": "WriteErrorLog", 
      "clsLogging.cls": "\n'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\n'* Class        :   clsLogging - High-performance CSV logger with Unicode support\n'* Author       :   VBATools\n'* Copyright    :   Apache License\n'* Version      :   2.0\n'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\n\n'---------------------------------------------------------------------------------------------------\n' ENUMERATIONS\n'---------------------------------------------------------------------------------------------------\nPublic Enum LOG_LEVEL\n    LOG_LEVEL_INFO = 0\n    LOG_LEVEL_WARNING = 1\n    LOG_LEVEL_ERROR = 2\nEnd Enum\n\n'---------------------------------------------------------------------------------------------------\n' CONSTANTS\n'---------------------------------------------------------------------------------------------------\nPrivate Const CLASS_NAME As String = \"clsLogging\"\n\n' Log file configuration\nPrivate Const DEFAULT_LOG_EXTENSION As String = \".csv\"\nPrivate Const DEFAULT_LOG_FILENAME As String = NAME_ADDIN & \"_logs\"\n\n' CSV configuration\nPrivate Const CSV_DELIMITER As String = \";\"\nPrivate Const CSV_HEADER As String = \"Timestamp\" & CSV_DELIMITER & \"Level\" & CSV_DELIMITER & \"Event\" & CSV_DELIMITER & \"Info\"\nPrivate Const QUOTE_CHAR As String = \"\"\"\"\n\n' FSO constants\nPrivate Const FSO_FOR_APPENDING As Integer = 8\nPrivate Const FSO_TRISTATE_TRUE As Long = -1\n\n' Buffer defaults\nPrivate Const DEFAULT_BUFFER_SIZE As Long = 5000\nPrivate Const MAX_MESSAGE_LENGTH As Long = 1000\n\n'---------------------------------------------------------------------------------------------------\n' MEMBER VARIABLES\n'---------------------------------------------------------------------------------------------------\nPrivate m_FSO As Object\nPrivate m_WorkbookPath As String\nPrivate m_LogFilePath As String\nPrivate m_Buffer As Collection\nPrivate m_MaxBufferSize As Long\n\n'===================================================================================================\n' PROPERTIES\n'===================================================================================================\n\n' Возвращает полный путь к файлу лога\nPublic Property Get FilePathLog() As String\n    FilePathLog = m_LogFilePath\nEnd Property\n\n' Устанавливает имя файла лога (без расширения)\nPublic Property Let FileNameLog(ByVal FileName As String)\n    Dim sName As String\n    \n    sName = Trim$(FileName)\n    If Len(sName) = 0 Then\n        sName = DEFAULT_LOG_FILENAME\n    End If\n    \n    m_LogFilePath = m_WorkbookPath & sName & DEFAULT_LOG_EXTENSION\nEnd Property\n\n' Устанавливает размер буфера перед принудительной записью\nPublic Property Let MaxBufferSize(ByVal Size As Long)\n    \n    Select Case Size\n        Case 0: m_MaxBufferSize = DEFAULT_BUFFER_SIZE\n        Case Is > 0:  m_MaxBufferSize = Size\n        Case Else: Err.Raise 5, CLASS_NAME & \".MaxBufferSize\", \"Buffer size must be greater than zero.\"\n    End Select\n\nEnd Property\n\n'===================================================================================================\n' INITIALIZATION / TERMINATION\n'===================================================================================================\n\nPrivate Sub Class_Initialize()\n    On Error GoTo ErrorHandler\n    \n    Set m_FSO = CreateObject(\"Scripting.FileSystemObject\")\n    Set m_Buffer = New Collection\n    \n    m_WorkbookPath = ThisWorkbook.Path & Application.PathSeparator\n\n    \n    Me.FileNameLog = DEFAULT_LOG_FILENAME\n    Exit Sub\n    \nErrorHandler:\n    Err.Raise Err.Number, CLASS_NAME & \".Class_Initialize\", _\n              \"Failed to initialize logger: \" & Err.Description\nEnd Sub\n\nPrivate Sub Class_Terminate()\n    ' Принудительно сохраняем буфер при уничтожении объекта\n    If Not m_Buffer Is Nothing Then\n        If m_Buffer.Count > 0 Then Call FlushBuffer\n        Set m_Buffer = Nothing\n    End If\n    Set m_FSO = Nothing\nEnd Sub\n\n'===================================================================================================\n' PUBLIC API\n'===================================================================================================\n\n' Логирование информационного сообщения\nPublic Sub LogInfo(ByVal EventX As String, Optional ByVal Info As String)\n    Call AddRecord(EventX, Info, LOG_LEVEL_INFO)\nEnd Sub\n\n' Логирование предупреждения\nPublic Sub LogWarning(ByVal EventX As String, Optional ByVal Info As String)\n    Call AddRecord(EventX, Info, LOG_LEVEL_WARNING)\nEnd Sub\n\n' Логирование ошибки с информацией из глобального объекта Err\nPublic Sub LogError(Optional ByVal FunctionName As String)\n    Dim sContext As String\n    \n    If Len(Trim$(FunctionName)) = 0 Then FunctionName = \"Unknown Procedure\"\n    \n    sContext = \"Err #\" & Err.Number & _\n               \" | Line: \" & Erl & _\n               \" | Description: \" & Err.Description\n    \n    Call AddRecord(FunctionName, sContext, LOG_LEVEL_ERROR, True)\nEnd Sub\n\n'===================================================================================================\n' CORE LOGIC\n'===================================================================================================\n\n' Основной метод добавления записи\nPublic Sub AddRecord( _\n    ByVal EventX As String, _\n    Optional ByVal Info As String, _\n    Optional ByVal Level As LOG_LEVEL = LOG_LEVEL_INFO, _\n    Optional ByVal ForceSave As Boolean = False)\n    \n    ' Валидация входных данных\n    Call ValidateInput(EventX, \"EventX\")\n    If IsMissing(Info) Then Info = vbNullString\n    \n    Dim sLevelTag As String\n    Dim csvLine As String\n    \n    ' Определение текстового уровня\n    sLevelTag = Choose(Level + 1, \"INFO\", \"WARNING\", \"ERROR\")\n    If Len(sLevelTag) = 0 Then sLevelTag = \"INFO\"\n    \n    ' Формирование CSV-строки\n    csvLine = EscapeCSV(Format$(Now, \"yyyy-mm-dd hh:nn:ss\")) & CSV_DELIMITER & _\n              EscapeCSV(sLevelTag) & CSV_DELIMITER & _\n              EscapeCSV(EventX) & CSV_DELIMITER & _\n              EscapeCSV(Info)\n    \n    ' Добавление в буфер (Collection вместо конкатенации)\n    m_Buffer.Add csvLine\n    \n    ' Проверка условий для записи на диск\n    If ForceSave Or (m_Buffer.Count >= m_MaxBufferSize) Then\n        Call FlushBuffer\n    End If\nEnd Sub\n\n' Принудительная запись буфера в файл\nPublic Sub FlushBuffer()\n    If m_Buffer.Count = 0 Then Exit Sub\n    \n    Dim sContent As String\n    Dim vItem As Variant\n    \n    ' Сборка буфера в одну строку\n    For Each vItem In m_Buffer\n        sContent = sContent & vItem & vbNewLine\n    Next vItem\n    \n    ' Запись и очистка\n    If AppendToFile(sContent) Then\n        Call ClearBuffer\n    Else\n        Call MsgBox(\"CRITICAL: Failed to write log buffer to \" & m_LogFilePath, vbCritical)\n    End If\nEnd Sub\n\n' Открытие лога во внешнем приложении\nPublic Sub ShowLog()\n    If Not m_FSO.FileExists(m_LogFilePath) Then\n        Call MsgBox(\"Log file does not exist\", vbInformation, NAME_ADDIN)\n        Exit Sub\n    End If\n    \n    On Error Resume Next\n    Call CreateObject(\"WScript.Shell\").Run(\"\"\"\" & m_LogFilePath & \"\"\"\")\n    On Error GoTo 0\nEnd Sub\n\n' Удаление лог-файла\nPublic Sub ResetLogs()\n    If Not m_FSO.FileExists(m_LogFilePath) Then\n        Call MsgBox(\"Log file not found.\", vbInformation, NAME_ADDIN)\n        Exit Sub\n    End If\n    \n    On Error Resume Next\n    Call m_FSO.DeleteFile(m_LogFilePath, True)\n    \n    If Err.Number = 0 Then\n        Call ClearBuffer\n        Call MsgBox(\"Log successfully cleared.\", vbInformation, NAME_ADDIN)\n    Else\n        Call MsgBox(\"Error deleting log:\" & Err.Description, vbExclamation, NAME_ADDIN)\n    End If\n    On Error GoTo 0\nEnd Sub\n\n'===================================================================================================\n' PRIVATE HELPERS\n'===================================================================================================\n\n' Очистка буфера\nPrivate Sub ClearBuffer()\n    Do While m_Buffer.Count > 0\n        m_Buffer.Remove 1\n    Loop\nEnd Sub\n\n' Экранирование спецсимволов для CSV\nPrivate Function EscapeCSV(ByVal txt As String) As String\n    Dim needsQuotes As Boolean\n    \n    ' Проверка на необходимость кавычек\n    needsQuotes = InStr(txt, CSV_DELIMITER) > 0 Or _\n                  InStr(txt, vbCr) > 0 Or _\n                  InStr(txt, vbLf) > 0 Or _\n                  InStr(txt, QUOTE_CHAR) > 0\n    \n    ' Удваивание кавычек (стандарт CSV RFC 4180)\n    txt = Replace$(txt, QUOTE_CHAR, QUOTE_CHAR & QUOTE_CHAR)\n    \n    If needsQuotes Then\n        EscapeCSV = QUOTE_CHAR & txt & QUOTE_CHAR\n    Else\n        EscapeCSV = txt\n    End If\nEnd Function\n\n' Дозапись в файл\nPrivate Function AppendToFile(ByVal text As String, Optional ByVal FilePath As String) As Boolean\n    Dim ts As Object\n    Dim targetPath As String\n    Dim bIsNewFile As Boolean\n    \n    On Error GoTo ErrorHandler\n    \n    targetPath = IIf(Len(FilePath) = 0, m_LogFilePath, FilePath)\n    bIsNewFile = Not m_FSO.FileExists(targetPath)\n    \n    Set ts = m_FSO.OpenTextFile(targetPath, FSO_FOR_APPENDING, True, FSO_TRISTATE_TRUE)\n    \n    With ts\n        If bIsNewFile Then Call .Write(CSV_HEADER & vbNewLine)\n        Call .Write(text)\n        .Close\n    End With\n    \n    AppendToFile = True\n    Set ts = Nothing\n    Exit Function\n    \nErrorHandler:\n    Debug.Print \"Error writing to log file [\" & targetPath & \"]: \" & Err.Description\n    AppendToFile = False\n    Set ts = Nothing\nEnd Function\n\n' Валидация входных параметров\nPrivate Sub ValidateInput(ByVal value As String, ByVal ParamName As String)\n    If Len(Trim$(value)) = 0 Then\n        Err.Raise 5, CLASS_NAME & \".\" & ParamName, \"Parameter cannot be empty or whitespace.\"\n    End If\n    \n    If Len(value) > MAX_MESSAGE_LENGTH Then\n        Err.Raise 5, CLASS_NAME & \".\" & ParamName, _\n              \"Parameter exceeds maximum length of \" & MAX_MESSAGE_LENGTH & \" characters.\"\n    End If\nEnd Sub", 
      "CODE": "Public Sub WriteErrorLog(ByVal sNameFunc As String)\r\n    'WriteErrorLog - записывает Log в файл\r\n    'sNameFunc - название отслеживаемой функции/процедуры, тип строковый\r\n\r\n    Dim LR     As LogRecorder\r\n    Set LR = New LogRecorder\r\n    \r\n    'Именить название Log файла, по умолчанию \"common\"\r\n    'LR.LogFileName = \"NewNameFileLog\"\r\n    \r\n    'Удаление всех запмсей в Log файле\r\n    'LR.ClearLog\r\n    \r\n    LR.WriteErrorLog (sNameFunc)\r\nEnd Sub", 
      "DISCRIPTION": "Запись лог файл ошибок для класса LogRecorder"
    }, 
    {
      "CODE_GRUP": "LogFile", 
      "CODE_SNIPPET": "WriteLog", 
      "clsLogging.cls": "\n'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\n'* Class        :   clsLogging - High-performance CSV logger with Unicode support\n'* Author       :   VBATools\n'* Copyright    :   Apache License\n'* Version      :   2.0\n'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\n\n'---------------------------------------------------------------------------------------------------\n' ENUMERATIONS\n'---------------------------------------------------------------------------------------------------\nPublic Enum LOG_LEVEL\n    LOG_LEVEL_INFO = 0\n    LOG_LEVEL_WARNING = 1\n    LOG_LEVEL_ERROR = 2\nEnd Enum\n\n'---------------------------------------------------------------------------------------------------\n' CONSTANTS\n'---------------------------------------------------------------------------------------------------\nPrivate Const CLASS_NAME As String = \"clsLogging\"\n\n' Log file configuration\nPrivate Const DEFAULT_LOG_EXTENSION As String = \".csv\"\nPrivate Const DEFAULT_LOG_FILENAME As String = NAME_ADDIN & \"_logs\"\n\n' CSV configuration\nPrivate Const CSV_DELIMITER As String = \";\"\nPrivate Const CSV_HEADER As String = \"Timestamp\" & CSV_DELIMITER & \"Level\" & CSV_DELIMITER & \"Event\" & CSV_DELIMITER & \"Info\"\nPrivate Const QUOTE_CHAR As String = \"\"\"\"\n\n' FSO constants\nPrivate Const FSO_FOR_APPENDING As Integer = 8\nPrivate Const FSO_TRISTATE_TRUE As Long = -1\n\n' Buffer defaults\nPrivate Const DEFAULT_BUFFER_SIZE As Long = 5000\nPrivate Const MAX_MESSAGE_LENGTH As Long = 1000\n\n'---------------------------------------------------------------------------------------------------\n' MEMBER VARIABLES\n'---------------------------------------------------------------------------------------------------\nPrivate m_FSO As Object\nPrivate m_WorkbookPath As String\nPrivate m_LogFilePath As String\nPrivate m_Buffer As Collection\nPrivate m_MaxBufferSize As Long\n\n'===================================================================================================\n' PROPERTIES\n'===================================================================================================\n\n' Возвращает полный путь к файлу лога\nPublic Property Get FilePathLog() As String\n    FilePathLog = m_LogFilePath\nEnd Property\n\n' Устанавливает имя файла лога (без расширения)\nPublic Property Let FileNameLog(ByVal FileName As String)\n    Dim sName As String\n    \n    sName = Trim$(FileName)\n    If Len(sName) = 0 Then\n        sName = DEFAULT_LOG_FILENAME\n    End If\n    \n    m_LogFilePath = m_WorkbookPath & sName & DEFAULT_LOG_EXTENSION\nEnd Property\n\n' Устанавливает размер буфера перед принудительной записью\nPublic Property Let MaxBufferSize(ByVal Size As Long)\n    \n    Select Case Size\n        Case 0: m_MaxBufferSize = DEFAULT_BUFFER_SIZE\n        Case Is > 0:  m_MaxBufferSize = Size\n        Case Else: Err.Raise 5, CLASS_NAME & \".MaxBufferSize\", \"Buffer size must be greater than zero.\"\n    End Select\n\nEnd Property\n\n'===================================================================================================\n' INITIALIZATION / TERMINATION\n'===================================================================================================\n\nPrivate Sub Class_Initialize()\n    On Error GoTo ErrorHandler\n    \n    Set m_FSO = CreateObject(\"Scripting.FileSystemObject\")\n    Set m_Buffer = New Collection\n    \n    m_WorkbookPath = ThisWorkbook.Path & Application.PathSeparator\n\n    \n    Me.FileNameLog = DEFAULT_LOG_FILENAME\n    Exit Sub\n    \nErrorHandler:\n    Err.Raise Err.Number, CLASS_NAME & \".Class_Initialize\", _\n              \"Failed to initialize logger: \" & Err.Description\nEnd Sub\n\nPrivate Sub Class_Terminate()\n    ' Принудительно сохраняем буфер при уничтожении объекта\n    If Not m_Buffer Is Nothing Then\n        If m_Buffer.Count > 0 Then Call FlushBuffer\n        Set m_Buffer = Nothing\n    End If\n    Set m_FSO = Nothing\nEnd Sub\n\n'===================================================================================================\n' PUBLIC API\n'===================================================================================================\n\n' Логирование информационного сообщения\nPublic Sub LogInfo(ByVal EventX As String, Optional ByVal Info As String)\n    Call AddRecord(EventX, Info, LOG_LEVEL_INFO)\nEnd Sub\n\n' Логирование предупреждения\nPublic Sub LogWarning(ByVal EventX As String, Optional ByVal Info As String)\n    Call AddRecord(EventX, Info, LOG_LEVEL_WARNING)\nEnd Sub\n\n' Логирование ошибки с информацией из глобального объекта Err\nPublic Sub LogError(Optional ByVal FunctionName As String)\n    Dim sContext As String\n    \n    If Len(Trim$(FunctionName)) = 0 Then FunctionName = \"Unknown Procedure\"\n    \n    sContext = \"Err #\" & Err.Number & _\n               \" | Line: \" & Erl & _\n               \" | Description: \" & Err.Description\n    \n    Call AddRecord(FunctionName, sContext, LOG_LEVEL_ERROR, True)\nEnd Sub\n\n'===================================================================================================\n' CORE LOGIC\n'===================================================================================================\n\n' Основной метод добавления записи\nPublic Sub AddRecord( _\n    ByVal EventX As String, _\n    Optional ByVal Info As String, _\n    Optional ByVal Level As LOG_LEVEL = LOG_LEVEL_INFO, _\n    Optional ByVal ForceSave As Boolean = False)\n    \n    ' Валидация входных данных\n    Call ValidateInput(EventX, \"EventX\")\n    If IsMissing(Info) Then Info = vbNullString\n    \n    Dim sLevelTag As String\n    Dim csvLine As String\n    \n    ' Определение текстового уровня\n    sLevelTag = Choose(Level + 1, \"INFO\", \"WARNING\", \"ERROR\")\n    If Len(sLevelTag) = 0 Then sLevelTag = \"INFO\"\n    \n    ' Формирование CSV-строки\n    csvLine = EscapeCSV(Format$(Now, \"yyyy-mm-dd hh:nn:ss\")) & CSV_DELIMITER & _\n              EscapeCSV(sLevelTag) & CSV_DELIMITER & _\n              EscapeCSV(EventX) & CSV_DELIMITER & _\n              EscapeCSV(Info)\n    \n    ' Добавление в буфер (Collection вместо конкатенации)\n    m_Buffer.Add csvLine\n    \n    ' Проверка условий для записи на диск\n    If ForceSave Or (m_Buffer.Count >= m_MaxBufferSize) Then\n        Call FlushBuffer\n    End If\nEnd Sub\n\n' Принудительная запись буфера в файл\nPublic Sub FlushBuffer()\n    If m_Buffer.Count = 0 Then Exit Sub\n    \n    Dim sContent As String\n    Dim vItem As Variant\n    \n    ' Сборка буфера в одну строку\n    For Each vItem In m_Buffer\n        sContent = sContent & vItem & vbNewLine\n    Next vItem\n    \n    ' Запись и очистка\n    If AppendToFile(sContent) Then\n        Call ClearBuffer\n    Else\n        Call MsgBox(\"CRITICAL: Failed to write log buffer to \" & m_LogFilePath, vbCritical)\n    End If\nEnd Sub\n\n' Открытие лога во внешнем приложении\nPublic Sub ShowLog()\n    If Not m_FSO.FileExists(m_LogFilePath) Then\n        Call MsgBox(\"Log file does not exist\", vbInformation, NAME_ADDIN)\n        Exit Sub\n    End If\n    \n    On Error Resume Next\n    Call CreateObject(\"WScript.Shell\").Run(\"\"\"\" & m_LogFilePath & \"\"\"\")\n    On Error GoTo 0\nEnd Sub\n\n' Удаление лог-файла\nPublic Sub ResetLogs()\n    If Not m_FSO.FileExists(m_LogFilePath) Then\n        Call MsgBox(\"Log file not found.\", vbInformation, NAME_ADDIN)\n        Exit Sub\n    End If\n    \n    On Error Resume Next\n    Call m_FSO.DeleteFile(m_LogFilePath, True)\n    \n    If Err.Number = 0 Then\n        Call ClearBuffer\n        Call MsgBox(\"Log successfully cleared.\", vbInformation, NAME_ADDIN)\n    Else\n        Call MsgBox(\"Error deleting log:\" & Err.Description, vbExclamation, NAME_ADDIN)\n    End If\n    On Error GoTo 0\nEnd Sub\n\n'===================================================================================================\n' PRIVATE HELPERS\n'===================================================================================================\n\n' Очистка буфера\nPrivate Sub ClearBuffer()\n    Do While m_Buffer.Count > 0\n        m_Buffer.Remove 1\n    Loop\nEnd Sub\n\n' Экранирование спецсимволов для CSV\nPrivate Function EscapeCSV(ByVal txt As String) As String\n    Dim needsQuotes As Boolean\n    \n    ' Проверка на необходимость кавычек\n    needsQuotes = InStr(txt, CSV_DELIMITER) > 0 Or _\n                  InStr(txt, vbCr) > 0 Or _\n                  InStr(txt, vbLf) > 0 Or _\n                  InStr(txt, QUOTE_CHAR) > 0\n    \n    ' Удваивание кавычек (стандарт CSV RFC 4180)\n    txt = Replace$(txt, QUOTE_CHAR, QUOTE_CHAR & QUOTE_CHAR)\n    \n    If needsQuotes Then\n        EscapeCSV = QUOTE_CHAR & txt & QUOTE_CHAR\n    Else\n        EscapeCSV = txt\n    End If\nEnd Function\n\n' Дозапись в файл\nPrivate Function AppendToFile(ByVal text As String, Optional ByVal FilePath As String) As Boolean\n    Dim ts As Object\n    Dim targetPath As String\n    Dim bIsNewFile As Boolean\n    \n    On Error GoTo ErrorHandler\n    \n    targetPath = IIf(Len(FilePath) = 0, m_LogFilePath, FilePath)\n    bIsNewFile = Not m_FSO.FileExists(targetPath)\n    \n    Set ts = m_FSO.OpenTextFile(targetPath, FSO_FOR_APPENDING, True, FSO_TRISTATE_TRUE)\n    \n    With ts\n        If bIsNewFile Then Call .Write(CSV_HEADER & vbNewLine)\n        Call .Write(text)\n        .Close\n    End With\n    \n    AppendToFile = True\n    Set ts = Nothing\n    Exit Function\n    \nErrorHandler:\n    Debug.Print \"Error writing to log file [\" & targetPath & \"]: \" & Err.Description\n    AppendToFile = False\n    Set ts = Nothing\nEnd Function\n\n' Валидация входных параметров\nPrivate Sub ValidateInput(ByVal value As String, ByVal ParamName As String)\n    If Len(Trim$(value)) = 0 Then\n        Err.Raise 5, CLASS_NAME & \".\" & ParamName, \"Parameter cannot be empty or whitespace.\"\n    End If\n    \n    If Len(value) > MAX_MESSAGE_LENGTH Then\n        Err.Raise 5, CLASS_NAME & \".\" & ParamName, _\n              \"Parameter exceeds maximum length of \" & MAX_MESSAGE_LENGTH & \" characters.\"\n    End If\nEnd Sub", 
      "CODE": "Public Sub WriteLog(ByVal EventX As String, Optional ByVal Info As String, _\r\n                    Optional ByVal Level As Integer = 0, _\r\n                    Optional ByVal LogSeparatorType As LOG_SEPARATOR_TYPE = LOG_SEPARATOR_NONE, _\r\n                    Optional ByVal ForceSavingLog As Boolean = False)\r\n    'WriteLog         - Запись произвольного лога\r\n    'EventX           - Описание события\r\n    'Info             - информация для сохранения\r\n    'Level            - количество отступов справа\r\n    'LogSeparatorType - тип выделения инофрмации\r\n    'ForceSavingLog   - сохранять или нет лог в файл\r\n\r\n    Dim LR     As LogRecorder\r\n    Set LR = New LogRecorder\r\n    \r\n    'Именить название Log файла, по умолчанию \"common\"\r\n    'LR.LogFileName = \"NewNameFileLog\"\r\n    \r\n    Call LR.AddRecord(EventX, Info, Level, LogSeparatorType, ForceSavingLog)\r\nEnd Sub", 
      "DISCRIPTION": "Запись лог файл для класса LogRecorder"
    }, 
    {
      "CODE_GRUP": "TxtFile", 
      "CODE_SNIPPET": "Base64", 
      "CODE": "Public Function Base64Encode(Text As String) As String\r\n    Dim web_Bytes() As Byte\r\n\r\n    web_Bytes = VBA.StrConv(Text, vbFromUnicode)\r\n    Base64Encode = web_AnsiBytesToBase64(web_Bytes)\r\n\r\n    Base64Encode = VBA.Replace$(Base64Encode, vbLf, \"\")\r\nEnd Function\r\nPublic Function Base64Decode(Encoded As Variant) As String\r\n    On Error GoTo errMsg\r\n    If (VBA.Len(Encoded) Mod 4 > 0) Then\r\n        Encoded = Encoded & VBA.Left(\"====\", 4 - (VBA.Len(Encoded) Mod 4))\r\n    End If\r\n\r\n    Dim web_XmlObj  As Object\r\n    Dim web_Node    As Object\r\n\r\n    Set web_XmlObj = CreateObject(\"MSXML2.DOMDocument\")\r\n    Set web_Node = web_XmlObj.createElement(\"b64\")\r\n\r\n    web_Node.DataType = \"bin.base64\"\r\n    web_Node.Text = Encoded\r\n    Base64Decode = VBA.StrConv(web_Node.nodeTypedValue, vbUnicode)\r\n\r\n    Set web_Node = Nothing\r\n    Set web_XmlObj = Nothing\r\n    Exit Function\r\nerrMsg:\r\n    Base64Decode = Encoded\r\n    Set web_Node = Nothing\r\n    Set web_XmlObj = Nothing\r\nEnd Function\r\nPrivate Function web_AnsiBytesToBase64(web_Bytes() As Byte)\r\n    Dim web_XmlObj  As Object\r\n    Dim web_Node    As Object\r\n\r\n    Set web_XmlObj = CreateObject(\"MSXML2.DOMDocument\")\r\n    Set web_Node = web_XmlObj.createElement(\"b64\")\r\n\r\n    web_Node.DataType = \"bin.base64\"\r\n    web_Node.nodeTypedValue = web_Bytes\r\n    web_AnsiBytesToBase64 = web_Node.Text\r\n\r\n    Set web_Node = Nothing\r\n    Set web_XmlObj = Nothing\r\nEnd Function", 
      "DISCRIPTION": "Две функции кодирования и декодирования строки Base64"
    }, 
    {
      "CODE_GRUP": "TxtFile", 
      "CODE_SNIPPET": "base64ToFile", 
      "CODE": "Public Sub base64ToFile(ByVal sHashBase64 As String, ByVal sFilePath As String)\r\n    Dim ByteArr()   As Byte\r\n    Dim oBase       As Object\r\n    Set oBase = CreateObject(\"MSXML2.DOMDocument\").createElement(\"b64\")\r\n    With oBase\r\n        .DataType = \"bin.base64\"\r\n        .Text = sHashBase64\r\n        ByteArr = .nodeTypedValue\r\n    End With\r\n    Open sFilePath For Binary Access Write As #1\r\n    Put #1, 1, ByteArr\r\n    Close #1\r\nEnd Sub", 
      "DISCRIPTION": "Создать файл из строки Base64"
    }, 
    {
      "CODE_GRUP": "TxtFile", 
      "CODE_SNIPPET": "fileToBase64", 
      "CODE": "Public Function fileToBase64(ByVal sFilePath As String) As String\r\n    Dim l           As Long\r\n    l = FileLen(sFilePath)\r\n    ReDim ByteArr(0 To l) As Byte\r\n    Open sFilePath For Binary As #1\r\n    Get #1, 1, ByteArr\r\n    Close #1\r\n    Dim oBase       As Object\r\n    Set oBase = CreateObject(\"MSXML2.DOMDocument\").createElement(\"b64\")\r\n    With oBase\r\n        .DataType = \"bin.base64\"\r\n        .nodeTypedValue = ByteArr\r\n        fileToBase64 = .Text\r\n    End With\r\nEnd Function", 
      "DISCRIPTION": "Создать  Base64 строку из файла"
    }, 
    {
      "CODE_GRUP": "TxtFile", 
      "CODE_SNIPPET": "loadTextFromTextFile", 
      "CODE": "Public Function loadTextFromTextFile(ByVal fileName As String, Optional ByVal encoding As String) As String\r\n    ' функция загружает текст в кодировке Charset из файла filename\r\n    ' encoding: koi8-r, ascii, utf-7, utf-8, utf-8noBOM, utf-16, Windows-1251, unicode\r\n    On Error Resume Next: Dim txt As String\r\n    If Trim(encoding) = \"\" Then encoding = \"windows-1251\"\r\n    With CreateObject(\"ADODB.Stream\")\r\n        .Type = 2:\r\n        If Len(encoding) Then .Charset = encoding\r\n        .Open\r\n        .LoadFromFile fileName        ' загружаем данные из файла\r\n        loadTextFromTextFile = .ReadText        ' считываем текст файла\r\n        .Close\r\n    End With\r\nEnd Function", 
      "DISCRIPTION": "Функция загружает текст в кодировке Charset из файла filename"
    }, 
    {
      "CODE_GRUP": "TxtFile", 
      "CODE_SNIPPET": "Range2CSV", 
      "CODE": "Function Range2CSV(ByRef ra As Range, ByVal DateMin As Date, ByVal DateMax As Date, Optional ByVal ColumnsSeparator$ = \";\", Optional ByVal RowsSeparator$ = vbNewLine) As String\r\n    If ra.Cells.Count = 1 Then Range2CSV = ra.Value & RowsSeparator$: Exit Function\r\n    If ra.Areas.Count > 1 Then\r\n        Dim ar      As Range\r\n        For Each ar In ra.Areas\r\n            Range2CSV = Range2CSV & Range2CSV(ar, DateMin, DateMax, ColumnsSeparator$, RowsSeparator$)\r\n        Next ar\r\n        Exit Function\r\n    End If\r\n    Dim arr         As Variant\r\n    Dim chr34       As String\r\n    Dim buffer      As String\r\n    Dim buffer2     As String\r\n    Dim txt         As String\r\n    Dim i           As Long\r\n    Dim j           As Long\r\n    Dim sTempStr    As String\r\n    arr = ra.Value\r\n\r\n    ' иначе конкатенация длинных текстовых строк притормаживает макрос\r\n    chr34 = Chr(34): buffer = \"\": buffer2 = \"\": Const BufferLen& = 15000\r\n    For i = LBound(arr, 1) To UBound(arr, 1)\r\n\r\n        If (arr(i, 2) <= DateMax And arr(i, 2) >= DateMin) Or Not IsDate(arr(i, 2)) Then\r\n            txt = \"\"\r\n            For j = LBound(arr, 2) To UBound(arr, 2)\r\n                '                sTempStr = chr34$ & Replace(arr(i, j), chr34, \"'\") & chr34\r\n                sTempStr = Replace(arr(i, j), chr34, \"'\")\r\n                sTempStr = VBA.Replace(sTempStr, ColumnsSeparator$, \" \")\r\n                txt = txt & ColumnsSeparator$ & sTempStr\r\n            Next j\r\n\r\n            buffer$ = buffer$ & Mid(txt, Len(ColumnsSeparator) + 1) & RowsSeparator\r\n\r\n            ' для многократного увеличения производительности при больших диапазонах данных\r\n            If Len(buffer) > BufferLen& Then\r\n                buffer2 = buffer2 & buffer: buffer = \"\"\r\n                If Len(buffer2$) > BufferLen& * 40 Then _\r\n                        Range2CSV = Range2CSV & buffer2: buffer2 = \"\"    ': DoEvents\r\n            End If\r\n        End If\r\n    Next i\r\n    Range2CSV = Range2CSV & buffer2 & buffer\r\nEnd Function", 
      "DISCRIPTION": "Диапазон загрузить в csv"
    }, 
    {
      "CODE_GRUP": "TxtFile", 
      "CODE_SNIPPET": "saveTextToFile", 
      "CODE": "Public Function saveTextToFile(ByVal txt As String, ByVal fileName As String, Optional ByVal encoding As String = \"windows-1251\") As Boolean\r\n    ' функция сохраняет текст txt в кодировке Charset$ в файл filename$\r\n    ' encoding: koi8-r, ascii, utf-7, utf-8, utf-8noBOM, utf-16, Windows-1251, unicode\r\n    On Error Resume Next: Err.Clear\r\n    Dim FSO         As Object\r\n    Dim ts          As Object\r\n    Select Case encoding$\r\n        Case \"windows-1251\", \"\", \"ansi\"\r\n            Set FSO = CreateObject(\"scripting.filesystemobject\")\r\n            Set ts = FSO.CreateTextFile(fileName, True)\r\n            ts.Write txt: ts.Close\r\n            Set ts = Nothing: Set FSO = Nothing\r\n\r\n        Case \"utf-16\", \"utf-16LE\"\r\n            Set FSO = CreateObject(\"scripting.filesystemobject\")\r\n            Set ts = FSO.CreateTextFile(fileName, True, True)\r\n            ts.Write txt: ts.Close\r\n            Set ts = Nothing: Set FSO = Nothing\r\n\r\n        Case \"utf-8noBOM\"\r\n            Dim binaryStream As Object\r\n            With CreateObject(\"ADODB.Stream\")\r\n                .Type = 2: .Charset = \"utf-8\": .Open\r\n                .WriteText txt$\r\n\r\n                Set binaryStream = CreateObject(\"ADODB.Stream\")\r\n                binaryStream.Type = 1: binaryStream.Mode = 3: binaryStream.Open\r\n                .Position = 3: .CopyTo binaryStream        'Skip BOM bytes\r\n                .flush: .Close\r\n                binaryStream.SaveToFile fileName$, 2\r\n                binaryStream.Close\r\n            End With\r\n\r\n        Case Else\r\n            With CreateObject(\"ADODB.Stream\")\r\n                .Type = 2: .Charset = encoding$: .Open\r\n                .WriteText txt$\r\n                .SaveToFile fileName$, 2        ' сохраняем файл в заданной кодировке\r\n                .Close\r\n            End With\r\n    End Select\r\n    saveTextToFile = Err = 0: DoEvents\r\nEnd Function", 
      "DISCRIPTION": "Функция сохраняет текст txt в кодировке Charset$ в файл"
    }, 
    {
      "CODE_GRUP": "TxtFile", 
      "CODE_SNIPPET": "TXTAddIntoTXTFile", 
      "CODE": "Public Function TXTAddIntoTXTFile(ByVal FileName As String, ByVal txt As String, Optional AddFile As Boolean = True) As Boolean\r\n    'TXTAddIntoTXTFile - логическа переменая, True - добавление удалось, False - нет\r\n    'FileName - строковая переменая, полный путь файла\r\n    'txt - текст добавляемый в фаил\r\n    'AddFile - логическа переменая, по умолчанию True, если нет файла то создаст его\r\n    \r\n    Dim FSO    As Object\r\n    Dim ts     As Object\r\n    On Error Resume Next: Err.Clear\r\n    Set FSO = CreateObject(\"scripting.filesystemobject\")\r\n    Set ts = FSO.OpenTextFile(FileName, 8, AddFile): ts.Write txt: ts.Close\r\n    TXTAddIntoTXTFile = Err = 0\r\n    Set ts = Nothing: Set FSO = Nothing\r\nEnd Function", 
      "DISCRIPTION": "Запись в файл строк, если файл не существует то создастся"
    }, 
    {
      "CODE_GRUP": "TxtFile", 
      "CODE_SNIPPET": "TXTReadALLFile", 
      "CODE": "Public Function TXTReadALLFile(ByVal FileName As String, Optional AddFile As Boolean = True) As String\r\n    'TXTReadALLFile - строковая переменая, возращающая содержание файла\r\n    'FileName - строковая переменая, полный путь файла\r\n    'AddFile - логическа переменая, по умолчанию True, если нет файла то создаст его\r\n    \r\n    Dim FSO    As Object\r\n    Dim ts     As Object\r\n    On Error Resume Next: Err.Clear\r\n    Set FSO = CreateObject(\"scripting.filesystemobject\")\r\n    Set ts = FSO.OpenTextFile(FileName, 1, AddFile): TXTReadALLFile = ts.ReadAll: ts.Close\r\n    Set ts = Nothing: Set FSO = Nothing\r\nEnd Function", 
      "DISCRIPTION": "Считать все данные из текстового файла"
    }, 
    {
      "CODE_GRUP": "TxtFile", 
      "CODE_SNIPPET": "TXTWriteFile", 
      "CODE": "Public Function TXTWriteFile(ByVal FileName As String, ByVal txt As String) As Boolean\r\n    'TXTWriteFile - логическа переменая, True - добавление удалось, False - нет\r\n    'FileName - строковая переменая, полный путь файла\r\n    'txt - текст добавляемый в фаил\r\n    \r\n    Dim FSO    As Object\r\n    Dim ts     As Object\r\n    On Error Resume Next: Err.Clear\r\n    Set FSO = CreateObject(\"scripting.filesystemobject\")\r\n    Set ts = FSO.CreateTextFile(FileName, True): ts.Write txt: ts.Close\r\n    TXTWriteFile = Err = 0\r\n    Set ts = Nothing: Set FSO = Nothing\r\nEnd Function", 
      "DISCRIPTION": "Запись в файл строк"
    }
  ]
}