aye cee
aye cee

Reputation: 193

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

I have a rectangle with no fill located over cell A1 to give the impression that A1 triggers the event.

The code for this rectangle opens and closes an ActiveX Listbox on click. The selections are output to a cell A1 named "ListBoxOutput" seperated by commas. I would instead like the Listbox to close when clicking anywhere outside the Listbox and for the last selection to have no comma after it.

This is the code:

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

Upvotes: 0

Views: 221

Answers (1)

Алексей Р
Алексей Р

Reputation: 7627

To use Worksheet_SelectionChange place the code in the Worksheet code module

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    With ActiveSheet.ListBox1
        If Target(1).Address = "$A$1" 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

Before (cursor on A1):
enter image description here
After (cursor on A2):
enter image description here

Upvotes: 1

Related Questions