一、允许多项选择
代码如下
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