|
代码也不复杂,只是有些电脑不支持 Listview
- Option Explicit
- Dim arr, i&
- Private Sub cmd取消_Click()
- Unload Me
- End Sub
- Private Sub cmd确认_Click()
- Dim s1$, s2$
- Rem 被选中的二级目录
- For i = 1 To ListView1.ListItems.Count
- If ListView1.ListItems(i).Checked Then s1 = IIf(s1 = "", ListView1.ListItems(i).Text, s1 & "," & ListView1.ListItems(i).Text)
- Next
- Rem 被选中的三级目录
- For i = 1 To ListView2.ListItems.Count
- If ListView2.ListItems(i).Checked Then s2 = IIf(s2 = "", ListView2.ListItems(i).Text, s2 & "," & ListView2.ListItems(i).Text)
- Next
- ActiveCell.Resize(1, 2) = Array(s1, s2)
- Unload Me
- End Sub
- Private Sub ListView1_ItemCheck(ByVal Item As MSComctlLib.ListItem)
- Dim t, xItem As MSComctlLib.ListItem
- If Item.Checked Then
- For Each t In Split(Item.Tag, "|")
- Set xItem = ListView2.ListItems.Add
- xItem.Text = t
- xItem.Tag = Item
- Next
- Else
- For i = ListView2.ListItems.Count To 1 Step -1
- Set xItem = ListView2.ListItems(i)
- If xItem.Tag = Item.Text Then ListView2.ListItems.Remove (xItem.Index)
- Next
- End If
- End Sub
- Private Sub UserForm_Initialize()
- Dim key$, Item As MSComctlLib.ListItem
- arr = Sheet2.Range("A1").CurrentRegion
- ListView1.ColumnHeaders.Add , , "业务大类", ListView1.Width - 15
- For i = 2 To UBound(arr)
- If Trim(arr(i, 1)) <> "" Then
- Set Item = ListView1.ListItems.Add
- Item.Text = Trim(arr(i, 1))
- Item.Tag = Trim(arr(i, 2)) '若每类的产品多可能出现错误
- Else
- Item.Tag = Item.Tag & "|" & Trim(arr(i, 2))
- End If
- Next
- ListView2.ColumnHeaders.Add , , "产品名称", ListView2.Width - 15
- Sheet1.Select
- End Sub
复制代码 |
|