ElseIf strTagArray(2) = "UnifiedToRecord" And objControlChecked.Name = "ListBox2" Then

Private Sub Button_AddEvent_Click()
    Dim objControlChecked As Object
    Dim ar(5)

    For Each objControlChecked In Me.Controls    'Проходим циклом по тэгам элементов формы
        Select Case objControlChecked.Name
        Case "TextBox_Event", "ComboBox_DD", "ComboBox_MM", "ComboBox_YYYY"
            If Len(objControlChecked) = 0 Then
                MsgBox "не заполнены обязательные поля": Exit Sub
            End If
        Case "ListBox2"
            If Me.ListBox2.ListCount = 0 Then
                MsgBox "не заполнены обязательные поля": Exit Sub
            End If
        End Select
       
    Next
    ar(0) = Me.TextBox_Event.Text
    ar(1) = DateSerial(Me.ComboBox_YYYY.Value, Me.ComboBox_MM.Value, Me.ComboBox_DD.Value)
    For i = 0 To Me.ListBox2.ListCount - 1
        If Me.ListBox2.Selected(i) Then s = s & vbNewLine & Me.ListBox2.List(i)
    Next i
    ar(2) = s
    ar(5) = Me.TextBox_Comment.Text

    With Sheets(1)
        .Cells(.ListObjects(1).ListRows.Count + .ListObjects(1).Range.Row + 1, 2).Resize(, 6).Value = ar
    End With


    '    Если данные внесены, предлагаем добавить следующую запись, либо закрываем форму и обновляем таблицу
    If MsgBox("Добавить еще мероприятие?", vbYesNo) = vbYes And vbNo Then
        If vbYes Then Call Button_Clear_Click
    ElseIf vbNo Then Unload Me
        Call Сортировка_План
    End If
    Application.CutCopyMode = True
End Sub

s=Mid(s, 2)