Excel设置多选下拉框

Excel设置多选下拉框

1.设置文件类型启用宏

将excel文件保存为.xlsm文件
a.打开文件——选项 点击 自定义功能区，勾选开发工具，点击确定
b.选中单元格，点击开发工具，点击插入选择activeX控件的第四个，在表格中画框，点击属性


3.属性修改如图三处

字典表格如下：

4.编辑代码

Private Sub ListBox1_Change()
 
    If Reload Then Exit Sub '加载ListBox1
     
    For i = 0 To ListBox1.ListCount - 1
     
        If ListBox1.Selected(i) = True Then t = t & "," & ListBox1.List(i)
     
    Next
     
    ActiveCell = Mid(t, 2)
 
End Sub
 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 
    With ListBox1
        .Top = Target.Top 'listbox的顶端位置
        
        .Left = Target.Left + Target.Width 'listbox的左端位置
        
        .Width = 90 '宽度
        
        '.Height = 150 '高度
        
        '.Visible = True '可见
        
        .ColumnHeads = False '不显示标题行
        
        '.ColumnCount = 10 '一共显示列，不设置全部显示
        
        '.ColumnWidths = "100;100" '可以设置每列的宽度，用分号隔开
        
        '.List = lists '数据来源
        
        .MultiSelect = fmMultiSelectMulti '允许通过鼠标点击的方式进行多选
        
        .ListStyle = fmListStyleOption '选项按钮设置为方形
 
        '第 2 列 且 单元格大于 1，因为表头的字段不需要进行多选
 
        If ActiveCell.Column = 5 And ActiveCell.Row > 1 Then
 
            t = ActiveCell.Value
 
            Reload = True '如果是根据单元格的值修改列表框，则暂时屏蔽listbox的change事件。
 
            For i = 0 To .ListCount - 1 '根据活动单元格内容修改列表框中被选中的内容
 
                If InStr(t, .List(i)) Then
 
                    .Selected(i) = True
 
                    Else
 
                    .Selected(i) = False
 
                End If
 
            Next
 
            Reload = False
 
            .Top = ActiveCell.Top + ActiveCell.Height '以下语句根据活动单元格位置显示列表框
 
            '.Left = ActiveCell.Left
 
            '.Width = ActiveCell.Width
 
            .Visible = True
 
            Else
 
            .Visible = False
 
        End If
 
    End With
 End Sub