VBA在特定条件下取消选择用户表单列表框中的项目

Question

我正在使用下面的代码让用户在填写用户表单时从列表中选择项目。

但是，当用户选择其他项目时，如果他选择了“其他”项目以外的任何项目，我想取消选择同一列表框中的所有项目。

下面是代码，我正在尝试，但是如果用户在列表框中选择“其他”项目，我不知道如何取消选择用户表单中的 所有 项目。

    For x = 0 To Me.LBX2.ListCount - 1
        If Me.LBX2.Selected(x) Then
            If Me.LBX2.List(x) = "Other" Then
                Me.LBX2.Selected(x) = False      '---This doesn't Deselect the items, not sure why-----
                If myVar1 = "" Then
                    myVar1 = Me.LBX2.List(x, 0)
                Else
                    myVar1 = myVar1 & vbLf & Me.LBX2.List(x, 0)
                End If
            End If
        End If
    Next x

Answer 1

多选时，Click 事件不可用，使用 Change 事件需要一些逻辑来避免死循环。

Option Explicit

Public EnableEvents As Boolean

Private Sub ListBox1_change()
    If Not Me.EnableEvents Then Exit Sub
    
    Dim isOther As Boolean, i As Long, n As Long
    Dim var1 As String
    
    With ListBox1
        n = .ListIndex
        If n < 0 Then Exit Sub
        If .List(n) = "Other" Then
            isOther = True
            var1 = .List(n)
        End If

        Me.EnableEvents = False
        For i = 0 To .ListCount - 1
            If isOther Then
               If i <> n Then .Selected(i) = False
            ElseIf .List(i) = "Other" Then
               .Selected(i) = False
            ElseIf .Selected(i) Then
                If Len(var1) Then var1 = var1 & vbLf
                var1 = var1 & .List(i)
            End If
        Next
        Me.EnableEvents = True
    End With
    MsgBox var1

End Sub

Private Sub UserForm_Initialize()
    EnableEvents = True
End Sub

Answer 2

有条件地取消选择多选列表框项目

如果我理解正确，您有两种情况：

• 一个元素 Other 已被选中：~~> 取消选择除所选列表元素“其他”之外的所有先前选择的项目（但记住剩余的项目）
• no 元素 Other 已被选中：~~> 记住所有选中的项目（当然不包括字符串 "Other"）

您可以编码如下收集所有选定的项目（数字） - 除了"Other" - 在数组no：

Private Sub CommandButton1_Click()
    Dim elem: ReDim elem(0 To Me.LBX2.ListCount - 1)
    Dim i As Long, nxt As Long: nxt = -1
'a) check element (numbers) of selected items
    For i = 0 To Me.LBX2.ListCount - 1
        If Me.LBX2.Selected(i) Then
            If Me.LBX2.List(i, 0) = "Other" Then
                Dim unselect As Boolean
                unselect = True     ' get status "unselect"
            Else                    ' selected element other than "Other"
                nxt = nxt + 1       ' increment counter
                elem(nxt) = i       ' remember element number
            End If
        End If
    Next
    If nxt > -1 Then
        ReDim Preserve elem(0 To nxt)            ' reduce array length to found items
    Else: Debug.Print "Nothing found to (un)select!": Exit Sub
    End If
'b) remember number & value of selected elements other than "Other"
    If unselect Then
        Debug.Print "A) Unselected: " & vbNewLine & " #";
        For i = 0 To UBound(elem)
            Me.LBX2.Selected(elem(i)) = False   ' << unselect
            elem(i) = elem(i) & " " & Me.LBX2.List(elem(i), 0)
        Next
    Else
        Debug.Print "B) Selected: " & vbNewLine & " #";
        For i = 0 To UBound(elem)
            elem(i) = elem(i) & " " & Me.LBX2.List(elem(i), 0)
        Next
    End If
'c) display un|selected element (number plus value) in VB Editor's immediate window
    Debug.Print Join(elem, vbNewLine & " #")
End Sub

为了让问题可以用一些伪数据重现，我添加了以下初始化过程：

Private Sub UserForm_Initialize()
    With Me.LBX2
        .MultiSelect = fmMultiSelectMulti
        .List = Split("a,b,Other,c,d,e", ",")
    End With
End Sub