VBA: обработка ошибок при вставке значений списка множественного выбора в ячейку

Question

Мне нужна помощь в улучшении кода или, если мой код уже довольно хорош, меня интересуют альтернативные способы сделать это.

Что я хочу сделать: В Excel у меня есть пользовательская форма, в которой пользователь вводит имя, возраст, цвет волос и т. Д. (По одному человеку за раз). Для чего-то вроде цвета волос я дал 5 предопределенных вариантов выбора в списке, и, поскольку люди могут менять цвет волос, включается множественный выбор. Выбранный цвет волос (один или несколько) затем вставляется в конкретную ячейку.

Проблема: Я немного боролся с обработкой ошибок, когда пользователь забывает выбрать цвет волос.

Рабочий код: Я заставил его работать со следующим кодом

Private Sub cmdSubmit_Click()
  Dim cnt As Long
  Dim LastRow As Long
  Dim s As String
  Dim i As Integer

  With Me.lbxHair
    For i = 0 To .ListCount - 1
        If .Selected(i) = True Then
            s = s & .List(i) & ","
            cnt = cnt + 1
        End If
    Next i
  End With

  If cnt = 0 Then
    MsgBox "No hair color selected"
    Exit Sub
  Else
    Cells(LastRow + 1, 1).Value = Me.tbxName.Value
    Me.tbxName.Value = ""
    Me.tbxName.SetFocus

    Range("B" & LastRow + 1).Value = Left(s, Len(s) - 1)
    On Error Resume Next
  End If

End Sub

Это прекрасно для моих целей, но есть ли способ сделать это без вспомогательной переменной cnt? Я пробовал это, потому что я прочитал .ListIndex = -1 означает, что ничего не выбрано

нерабочий код (такое же объявление переменной, как указано выше):

With Me.lbxHair
    If .ListIndex = -1 Then
        MsgBox "No hair color selected"
        Exit Sub
    Else
        For i = 0 To .ListCount - 1
            If .Selected(i) = True Then s = s & .List(i) & ","
        Next i
    End If
End With

    Cells(LastRow + 1, 1).Value = Me.tbxName.Value
    Me.tbxName.Value = ""
    Me.tbxName.SetFocus
    Range("B" & LastRow + 1).Value = Left(s, Len(s) - 1)
    On Error Resume Next

При попытке не выбирать что-либо, я получаю «Ошибка времени выполнения 5»: неверный вызов процедуры или аргумент »

Почему? Кроме того, есть ли у вас какие-либо другие предложения, как мне это сделать или как я могу улучшить свой код?

Answer 1

Вы можете попробовать что-то вроде этого:

Private Sub cmdSubmit_Click()

  Dim LastRow As Long
  Dim s As String, sep As String
  Dim i As Integer

  With Me.lbxHair
    For i = 0 To .ListCount - 1
        If .Selected(i) = True Then
            s = s & sep & .List(i)
            sep = ","
        End If
    Next i
  End With

  If Len(s) = 0 Then
    MsgBox "No hair color selected"
    Exit Sub
  Else
    Cells(LastRow + 1, 1).Value = Me.tbxName.Value
    Cells(LastRow + 1, 2).Value = s
    Me.tbxName.Value = ""
    Me.tbxName.SetFocus

  End If

End Sub