Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Ошибка при работе макроса в пользовательской форме
 
#1
15.01.2021 14:22:59
Уважаемы форумчане помогите!
Есть вот такой макрос в UserForm для добавления нового лица. Несколько дней он работал, а вот теперь выдает ошибку, после которой закрывается Excel.
Помогите понять, что произошло.
Спасибо.
Код
Private Sub Add_new_requestor()
    Dim SheetClient As Worksheet
    Dim SheetClientListobj As ListObject
    Dim SheetClientlistrow As ListRow
    Dim cell As Range, r As Long
    Set SheetClient = ThisWorkbook.Worksheets("Client&Requestor")
    Set SheetClientListobj = SheetClient.ListObjects("Requestor_tb")
    Set cell = SheetClientListobj.ListColumns.Item(1).Range.Find(Me.Requestor_Cbox.Value, lookat:=xlWhole)
    If Not cell Is Nothing Then
    Exit Sub
    Else
    r = MsgBox("Would you like to add a requestor to the list?", vbYesNo, "Execution request")
    If r = vbNo Then
    Exit Sub
    Else
    Set SheetClientlistrow = SheetClientListobj.ListRows.Add
    SheetClientlistrow.Range(1) = Me.Requestor_Cbox.Text
    End If
    End If
End Sub
 
 
 
#2
15.01.2021 15:04:46
Пожалуйста смотрите пример.
В поле "Requestor" пытаюсь ввести новое имя и добавить в список, но выдает ошибку.
Спасибо
 
 
 
#3
15.01.2021 16:50:52
Marina55573, Если переименовать умную таблицу Requestor_tb во что-нибудь другое, например, Requestor_tb2, то всё работает. См. файл
P.S. Видно, какой-то глюк
 
 
 
#4
15.01.2021 17:25:25
Уважаемый New
Спасибо за Вашу помощь.
Я заметила, что если в форме в ComboBox выпадающей список не добавлять, то работает.
А если добавить список, то опять эта ошибка.
Что это может быть?  :cry:  
 
 
 
#5
15.01.2021 17:41:55
Давайте обманим, я добавил 2 строки в код, у меня работает без ошибок

Код
Private Sub Add_new_requestor()
    Dim SheetClient As Worksheet
    Dim SheetClientListobj As ListObject
    Dim SheetClientlistrow As ListRow
    Dim cell As Range, r As Long
    
    Set SheetClient = ThisWorkbook.Worksheets("Client&Requestor")
    Set SheetClientListobj = SheetClient.ListObjects("Requestor_tb2")
    
    Set cell = SheetClientListobj.ListColumns.Item(1).Range.Find(Me.Requestor_Cbox.Value, lookat:=xlWhole)
    If Not cell Is Nothing Then
        Exit Sub
    Else
        r = MsgBox("Would you like to add a requestor to the list?", vbYesNo, "Execution request")
        If r = vbNo Then
            Exit Sub
        Else
            Me.Requestor_Cbox.RowSource = "" '<-- add
            Set SheetClientlistrow = SheetClientListobj.ListRows.Add
            SheetClientlistrow.Range(1) = Me.Requestor_Cbox.Text
            Me.Requestor_Cbox.RowSource = SheetClientListobj.Name '<-- add
        End If
    End If
    MsgBox "Requestor successfully added!", vbInformation, ""
End Sub
Изменено: New - 15.01.2021 17:42:52
 
 
 
#6
15.01.2021 17:50:53
Огромное Вам New спасибо!!!
Все работает  :D  :D  :D
Вы меня просто спасли  :)  
Изменено: Marina55573 - 15.01.2021 17:53:00
 
 
 
Страницы: 1
Наверх