Drop down list with checkbox in Excel

Add a ListBox.
Propperties of the ListBox:


Add a Button.
Code for the Button:
VBA Code:
Sub Button3_Klikken[] 'Adjust number Dim xSelShp As Shape, xSelLst As Variant, I, J As Integer Dim xV As String, xActivecellStr As String Set xSelShp = ActiveSheet.Shapes["Button 3"] 'ActiveSheet.Shapes[Application.Caller] Set xLstBox = ActiveSheet.ListBox1 xActivecellStr = ActiveCell.Address If xLstBox.Visible = False Then xLstBox.Visible = True xSelShp.Select Selection.Characters.Text = "Save choices" xStr = "" xStr = Range[xActivecellStr] 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.Select Selection.Characters.Text = "Choice" For I = xLstBox.ListCount - 1 To 0 Step -1 If xLstBox.Selected[I] = True Then xSelLst = xLstBox.List[I] & ";" & xSelLst xLstBox.Selected[I] = False End If Next I If xSelLst "" Then Range[xActivecellStr] = Mid[xSelLst, 1, Len[xSelLst] - 1] Else Range[xActivecellStr] = "" End If End If ActiveSheet.Range[xActivecellStr].Select End Sub
mart37 said:
Add a ListBox.
Propperties of the ListBox:
View attachment 29963

Add a Button.
Code for the Button:
VBA Code:
Sub Button3_Klikken[] 'Adjust number Dim xSelShp As Shape, xSelLst As Variant, I, J As Integer Dim xV As String, xActivecellStr As String Set xSelShp = ActiveSheet.Shapes["Button 3"] 'ActiveSheet.Shapes[Application.Caller] Set xLstBox = ActiveSheet.ListBox1 xActivecellStr = ActiveCell.Address If xLstBox.Visible = False Then xLstBox.Visible = True xSelShp.Select Selection.Characters.Text = "Save choices" xStr = "" xStr = Range[xActivecellStr] 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.Select Selection.Characters.Text = "Choice" For I = xLstBox.ListCount - 1 To 0 Step -1 If xLstBox.Selected[I] = True Then xSelLst = xLstBox.List[I] & ";" & xSelLst xLstBox.Selected[I] = False End If Next I If xSelLst "" Then Range[xActivecellStr] = Mid[xSelLst, 1, Len[xSelLst] - 1] Else Range[xActivecellStr] = "" End If End If ActiveSheet.Range[xActivecellStr].Select End Sub
Click to expand...
Thank you,
Until the button all is ok, after not getting it. Can you please give m the final example how it looks?

Video liên quan

Chủ Đề