VBA自学应用（12）——允许列表框多项选择和多列

一、允许多项选择

代码如下

Private Sub UserForm_Initialize()
    arr = Sheets("产品表").Range("a1").CurrentRegion
    With ListBox1
    '设置列表框属性
        .List = arr
        .MultiSelect = fmMultiSelectExtended
        .ColumnCount = UBound(arr, 2)
        .ListStyle = fmListStyleOption
    End With
End Sub

object.MultiSelect [= fmMultiSelect]

• fmMultiSelect设置值

常量	值	说明
fmMultiselectsingle	0	只可选择1个条目（默认）
fmMultiselectMulti	1	按space键或单击以选中列表中1个条目或取消选中
fmMultiselectExtended	2	按shift键可以扩展选中条目,按ctrl的同时单击可以选择多个

object.liststyle [= fmliststyle]

• fmliststyle设置值

常量	值	说明
fmliststyleplain	0	外观与常规的列表框相似，条目的背景为高亮
fmliststyleoption	1	显示选项按钮，或显示用于多重选择列表的复选框（默认）。当用户选中组中的条目时，与该条目相关的选项按钮即被选中，而该组其他条目的选项按钮被取消选中

二、设置多列列表框

Private Sub UserForm_Initialize()
    Dim lngLast As Long
    lngLast = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row
    With lstData
        .ColumnCount = 7
        .ColumnWidths = "45;45;45;45;45;45;45"
        .BoundColumn = 1
        .ColumnHeads = True
        .RowSource = Sheet1.Range("A2:G" & lngLast).Address
    End With
End Sub

• object.columncount [= long]，指定列表框或组合框的显示列数
• object.columnwidths [= string]，如果columnwidths属性设置为-1或空，则将空间宽度等分给列表中的各列；设置为0则隐藏该列。若要指定另一种不同的度量单位，在设置时则必须包括该度量单位。如listbox1.columnwidhths = “4.5厘米;4.5厘米;6厘米”
• object.boundcolumn [= variant]，boundcolumn属性标识多列组合框或列表框值得数据来源
  boundcolumn属性值

值	说明
0	将被选中列表项的listindex属性的值赋予控件
1或大于1	将指定列中的值赋予控件。当采用此属性时，列从1开始计数（默认值）

三、将多列列表框的数据写入工作表

Private Sub lstData_Click()
    Dim lngLast As Long
    Dim i As Byte
    lngLast = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row + 1
    For i = 1 To lstData.ColumnCount
        Sheet1.Cells(lngLast, i) = lstData.Column(i - 1)
    Next i
End Sub

当将多列列表框的数据写入工作表中时，只能将boundcolumn属性所指定列中的值写入工作表，而不能将选中的整行内容写入工作表中。如果需要将选中行的整行内容写入工作表，则需要用到以上循环。

当然也可以用数组的方式写入数据到工作表，代码如下

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    '双击的时候也可以更改数据
    Dim crr()
    Dim m As Long
    For i = 0 To ListBox1.ListCount - 1
        If ListBox1.Selected(i) = True Then
            m = m + 1
            ReDim Preserve crr(1 To ListBox1.ColumnCount, 1 To m)
            For j = 0 To ListBox1.ColumnCount - 1
                crr(j + 1, m) = ListBox1.List(i, j)
            Next
        End If
    Next
    If m > 0 Then ActiveCell.Resize(m, j) = Application.Transpose(crr)
End Sub