Excel下拉列表多選框實現

程序猿130 2017-12-12

展開全文

Excel提供了下拉列表的實現，但并不支持多選，后來慢慢找資料終于利用VBA編程實現了多選的問題。

首先點擊視圖->宏，工程資源所示：

有Microsoft Excel對象：對應的是Sheet1或Sheet2對像等;

窗體:對應的是彈出的對話框；

模塊:對應的是調用某些功能的入口。

以Sheet1頁單擊D列為例彈出框供多選

1：

先建立宏，然后編輯，在"Microsoft Excel對象"中單擊"Sheet2"的右鍵-》查看代碼

將此代碼保存：

Private Sub Worksheet_SelectionChange(ByVal Target As Range) //說明：監(jiān)聽sheet1發(fā)生的用戶操作事件
    If ActiveCell.Column = 8 And ActiveCell.Row > 1 Then //說明:當前激活列為J列，第二行以下
        Call ShowFM2 //調用顯示窗體宏名
    End If
End Sub

2：

在工程資源-》"模塊"對象中 “插入模塊”-》查看代碼

保存如下代碼：

Sub ShowFM()
UserForm1.Show
End Sub

3：

在工程資源->"窗體"->插入"用戶窗體"

然后在"工具箱"里拖放"列表框"和"命令按鈕"到窗體上

接著點擊"查看代碼"

將以下代碼保存：

Private Sub CommandButton1_Click()
Dim Arr(), k&, i&
ReDim Arr(1 To 1)
With ListBox1
    For i = 0 To .ListCount - 1
        If .Selected(i) Then
            k = k + 1
            ReDim Preserve Arr(1 To k)
            'Arr(k) = .List(i, 1)
            Arr(k) = Sheet2.Range("A" & (i + 1)).Value //獲取Sheet2列表中A列i+1行的值
        End If
    Next i
End With
'MsgBox "您選擇了：" & Join(Arr, ",")
UserForm1.Hide
'Application.ActiveSheet.Range("A1").Value = Join(Arr, ",")
Application.ActiveCell.Value = Join(Arr, ",") //將值放入到當前單元格
End Sub

Private Sub ListBox1_Click()

End Sub

Private Sub TextBox1_Change()

End Sub

Private Sub UserForm_Initialize()
With UserForm1.ListBox1
    .RowSource = "Sheet2!A1:A49"    '設定源數據區(qū)域，下拉列表框的數據來源
    .ColumnCount = 1               '設定列數
    .ColumnHeads = False             '設定列標題。標題為數據區(qū)域的上一行
    .BoundColumn = 2
    .MultiSelect = fmMultiSelectMulti       '按空格鍵或單擊鼠標以選定列表中一個條目或取消選定。
'    .MultiSelect = fmMultiSelectExtended    '按 Shift 并單擊鼠標，或按 Shift 的同時按一個方向鍵，將所選條目由前一項擴展到當前項。按 Ctrl 的同時單擊鼠標可選定或取消選定。
'    .MultiSelect = fmMultiSelectSingle      '只可選擇一個條目（默認）。
End With
End Sub