Reputation: 193
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
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):
After (cursor on A2):
Upvotes: 1