Public WithEvents iCmndBtn As CommandButton 'Object 'Button

Public MyButton As New clsButton

Sub Add_Button()  'кнопки создается, но вылетает ошибка не соответствия типов
With ActiveSheet
'  On Error Resume Next
  Set MyButton.iCmndBtn = .OLEObjects.Add(ClassType:="Forms.CommandButton.1", Left:=400, Top:=90, Width:=27, Height:=27)
  Set MyButton.iCmndBtn = .Buttons.Add(405, 135, 26, 26)
End With
End Sub

Sub Макрос1() 'макрос отрабатывает без проблем
Dim iTmp As Object
With ActiveSheet
  Set iTmp = .OLEObjects.Add(ClassType:="Forms.CommandButton.1", Left:=300, Top:=100, Width:=27, Height:=27)
  Set iTmp = .Buttons.Add(305, 140, 26, 26)
End With
End Sub

Private Sub CommandButton1_Click()
Dim x(), iArr(), newArr(), I&, J&
x = Range("A1:F4").Value
On Error Resume Next
With CreateObject("Scripting.Dictionary")
    For I = 1 To UBound(x)
        .Add x(I, 1), Application.Index(x, I, 0)
        If Err <> 0 Then
            'так работает
            iArr = .Item(x(I, 1))
            For J = 2 To UBound(iArr)
                iArr(J) = iArr(J) + x(I, J)
            Next
            .Item(x(I, 1)) = iArr
'            'необходимо увеличить каждый элемент массива на определенное значение
'            'прямое изменение элемента массива не работает
'            For J = 2 To UBound(.Item(x(I, 1)))
'                .Item(x(I, 1))(J) = .Item(x(I, 1))(J) + x(I, J)
'            Next
            Err.Clear
        End If
    Next
    ReDim newArr(1 To .Count, 0 To UBound(x, 2)): I = Empty
    For Each iKey In .Keys
        I = I + 1: newArr(I, 0) = I
        'простое обращение к элементу массива работает
        For J = 1 To UBound(.Item(iKey))
            newArr(I, J) = .Item(iKey)(J)
        Next
    Next
End With
Range("A16").Resize(UBound(newArr), UBound(newArr, 2) + 1) = newArr
End Sub

Sub Test()
    'Русский язык, кирилица
    'браузер Chrome Версия 67.0.3396.87 (Официальная сборка), (64 бит)
End Sub

Sub Test()
    'Ðóññêèé ÿçûê, êèðèëèöà
    'áðàóçåð Chrome Âåðñèÿ 67.0.3396.87 (Îôèöèàëüíàÿ ñáîðêà), (64 áèò)
End Sub

Sub Test()
    '??????? ????, ????????
    '??????? Chrome ?????? 67.0.3396.87 (??????????? ??????), (64 ???)
End Sub

Sub Test()
    '??????? ????, ????????
    '??????? Chrome ?????? 67.0.3396.87 (??????????? ??????), (64 ???)
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("DAYS")) Is Nothing And Target.Count = 1 Then
    On Error Resume Next
    For I = 1 To Range("DAYS").Areas.Count
        If Not Intersect(Target, Range("DAYS").Areas(I)) Is Nothing Then
            iMonth = I
            Select Case I
                Case 1, 3, 5, 7, 8, 10, 12
                    eDay = 31
                Case 4, 6, 9, 11
                    eDay = 30
                Case 2
                    eDay = 28   'для високосного года исправить на 29
            End Select
            Exit For
        End If
    Next
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    If Target >= 1 And Target <= eDay Then
        Target = DateSerial(2018, iMonth, Target)
        Target.NumberFormat = "dd; @"
    Else
        MsgBox "Неверная дата!", vbCritical + vbOKOnly, "Ошибка"
        Target = Empty
        GoTo ExitSub
    End If
End If
ExitSub:
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

Sub Макрос3() 'записано макрорекордером
    With ActiveSheet.PageSetup
        .LeftHeader = "&""Arial,полужирный""СТР:&""-,обычный"" &D &T"
        .CenterHeader = "&""Arial,полужирный""СТРАНА:&""-,обычный"" Россия &""Arial,полужирный""РЕГИОН: &""-,обычный""Москва"
        .RightHeader = "&""Arial,полужирный""САЙТ:&""-,обычный"" WWW.MOS.GOV"
    End With
End Sub

Sub PreKolon2()
Country$ = "Россия"
City$ = "Москва"
Site$ = "WWW.MOS.GOV"
    With ActiveSheet.PageSetup
        .LeftHeader = "&""Arial,полужирный""СТР:&""-,обычный"" &D &T"   'Дата и Время
        
        'слова Россия, Москва заменить переменными Country, Сity
        .CenterHeader = "&""Arial,полужирный""СТРАНА:&""-,обычный"" Россия &""Arial,полужирный""РЕГИОН: &""-,обычный""Москва"
        
        'WWW.MOS.GOV заменить на Site
        .RightHeader = "&""Arial,полужирный""САЙТ:&""-,обычный"" WWW.MOS.GOV"
    End With
    ActiveSheet.PrintPreview
End Sub

Function UNIQUE(rng As Range) As Variant
Dim tmpArray()
Dim tmpCol As New Collection
On Error Resume Next
tmpArray = rng.Value
For I = LBound(tmpArray, 1) To UBound(tmpArray, 1)
    For J = 1 To rng.Columns.Count
        tmpCol.Add tmpArray(I, J), CStr(tmpArray(I, J))
    Next
Next
ReDim tmpArray(tmpCol.Count - 1, 1)
For I = 0 To tmpCol.Count - 1
    tmpArray(I, 0) = tmpCol(I + 1)
Next
UNIQUE = tmpArray
End Function

mDate = WorksheetFunction.Match("мар", {"янв","фев","мар","апр","мая","июн","июл","авг","сен","окт","ноя","дек"})

=ВПР(B3;ИНДЕКС(G3:G17;ПОИСКПОЗ(B2;F3:F17;0)):ИНДЕКС(H3:H17;ПОИСКПОЗ(B2;F3:F17));2;0)

Sub fmtCDDEL()
Dim fmtCD As FormatCondition
On Error GoTo Err
With Application
    .Calculation = xlCalculationManual
    .ScreenUpdating = False
End With
With Cells.FormatConditions
Ans = MsgBox("В Вашем файле " & .Count & " правил условного форматирования!" & Chr(13) & "Удалить их?", vbInformation + vbYesNo)
If Ans = vbNo Then Exit Sub
I = 1
Do While .Count <> 0
    Cells.FormatConditions(I).Delete
    Application.StatusBar = "Удаляется " & I & " правило. Пожалуйста подождите...."
    DoEvents
    I = I + 1
Loop
End With
Err:
With Application
If Cells.FormatConditions.Count <> 0 Then
        .StatusBar = "Не удалено " & Cells.FormatConditions.Count & ", запустите макрос еще раз..."
    Else
        .StatusBar = False
    End If
    .Calculation = xlCalculationAutomatic
    .ScreenUpdating = True
End With
End Sub

Sub SaveText_2()
Dim SH As Object
I = 1
For Each SH In ActiveSheet.Shapes
    With SH.OLEFormat.Object
        If SH.Type <> msoTextBox Or .Text Like "*Внимание*" Then GoTo 10
            Worksheets(2).Range("A" & I).Value = .Text
    End With
I = I + 1
10 Next
End Sub

Sub SaveText_3()
Dim SH As Object
I = 1
For Each SH In ActiveSheet.Shapes
    With SH.OLEFormat.Object
        If SH.Type <> msoTextBox Then GoTo 10
        If .Text Like "*Внимание*" Then GoTo 10
            Worksheets(2).Range("A" & I).Value = .Text
    End With
I = I + 1
10 Next
End Sub

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function DrawMenuBar Lib "user32" (ByVal hWnd As Long) As Long
Private Const GWL_STYLE As Long = (-16)
Private Const WS_SYSMENU As Long = &H80000
Private Const WS_MINIMIZEBOX As Long = &H20000
Private Const WS_MAXIMIZEBOX As Long = &H10000

Private Sub UserForm_Initialize()
Dim lngFrmHndl As Long, lngStyle As Long
    
    lngFrmHndl = FindWindow(vbNullString, Me.Caption)
    lngStyle = GetWindowLong(lngFrmHndl, GWL_STYLE)
    lngStyle = lngStyle Or WS_SYSMENU
    lngStyle = lngStyle Or WS_MINIMIZEBOX
    lngStyle = lngStyle Or WS_MAXIMIZEBOX
    SetWindowLong lngFrmHndl, GWL_STYLE, (lngStyle)
    DrawMenuBar lngFrmHndl
End Sub

    .ListObjects.Add(xlSrcRange, .Range("A1:B" & LastCol - 1), , xlYes).TableStyle = "TableStyleLight19"