Excel Activex 列表框在单击矩形时打开，在列表框未获得焦点时关闭，并将选择输出到单元格

Question

我在单元格 A1 上有一个没有填充的矩形，给人的印象是 A1 触发了事件。

此矩形的代码在单击时打开和关闭 ActiveX 列表框。选择被输出到名为“ListBoxOutput”的单元格 A1，用逗号分隔。相反，我希望在单击列表框外的任何位置时关闭列表框，并且最后一个选择后面没有逗号。

这是代码：

Sub Rectangle3_Click()

    Dim xSelShp As Shape, xSelLst As Variant, I, J As Integer
    Dim xV As String
    Set xSelShp = ActiveSheet.Shapes(Application.Caller)
    Set xLstBox = ActiveSheet.ListBox1
        If xLstBox.Visible = False Then
            xLstBox.Visible = True
            xSelShp.TextFrame2.TextRange.Characters.Text = ""
            xStr = ""
            xStr = Range("ListBoxOutput").Value
     
            If xStr <> "" Then
                xArr = Split(xStr, ", ")
                For I = xLstBox.ListCount - 1 To 0 Step -1
                xV = xLstBox.List(I)
                For J = 0 To UBound(xArr)
            
                If xArr(J) = xV Then
                    xLstBox.Selected(I) = True
                    Exit For
                End If
        
                Next
                Next I
            End If
        
            Else
                xLstBox.Visible = False
                xSelShp.TextFrame2.TextRange.Characters.Text = ""
                For I = xLstBox.ListCount - 1 To 0 Step -1
                
                If xLstBox.Selected(I) = True Then
                    xSelLst = xLstBox.List(I) & ", " & xSelLst
                End If
                
                Next I
                    If xSelLst <> "" Then
                        Range("ListBoxOutput") = Mid(xSelLst, 1, Len(xSelLst) - 1)
                    Else
                        Range("ListBoxOutput") = ""
                    End If
            End If
End Sub

Answer 1

要使用 Worksheet_SelectionChange 将代码放在 Worksheet code module

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    With ActiveSheet.ListBox1
        If Target(1).Address = "$A" Then
            .Visible = True
        Else
            .Visible = False
            For i = 0 To .ListCount - 1
                If .Selected(i) Then txt = txt & "," & .List(i)
            Next
            [A1] = Mid(txt, 2)  'remove first comma and output to A1 cell
        End If
    End With
End Sub

之前（光标在 A1 上）：

之后（A2 上的光标）：

Excel Activex 列表框在单击矩形时打开，在列表框未获得焦点时关闭，并将选择输出到单元格

Excel Activex Listbox to open on rectangle click, close when listbox not in focus, and output selections to cell

excel

vba

activex

listbox