根据数据字典生成多级下拉菜单，每一级级下拉菜单可多选

一指禅62

用 ListView 控件显示列表，可实现放弃业务大类时，移除产品列表中的相应条目。这是 ListBox 控件无法企及的。



级联多选.rar (30.93 KB, 下载次数: 130)

2017-12-19 16:40 上传

点击文件名下载附件

一指禅62

代码也不复杂，只是有些电脑不支持 Listview

1. Option Explicit
   
2. Dim arr, i&
   
3. 
   
4. Private Sub cmd取消_Click()
   
5.     Unload Me
   
6. End Sub
   
7. 
   
8. Private Sub cmd确认_Click()
   
9.     Dim s1$, s2$
   
10.     Rem 被选中的二级目录
    
11.     For i = 1 To ListView1.ListItems.Count
    
12.         If ListView1.ListItems(i).Checked Then s1 = IIf(s1 = "", ListView1.ListItems(i).Text, s1 & "," & ListView1.ListItems(i).Text)
    
13.     Next
    
14.     Rem 被选中的三级目录
    
15.     For i = 1 To ListView2.ListItems.Count
    
16.         If ListView2.ListItems(i).Checked Then s2 = IIf(s2 = "", ListView2.ListItems(i).Text, s2 & "," & ListView2.ListItems(i).Text)
    
17.     Next
    
18.     ActiveCell.Resize(1, 2) = Array(s1, s2)
    
19.     Unload Me
    
20. End Sub
    
21. 
    
22. Private Sub ListView1_ItemCheck(ByVal Item As MSComctlLib.ListItem)
    
23.     Dim t, xItem As MSComctlLib.ListItem
    
24.     If Item.Checked Then
    
25.         For Each t In Split(Item.Tag, "|")
    
26.             Set xItem = ListView2.ListItems.Add
    
27.             xItem.Text = t
    
28.             xItem.Tag = Item
    
29.         Next
    
30.     Else
    
31.         For i = ListView2.ListItems.Count To 1 Step -1
    
32.             Set xItem = ListView2.ListItems(i)
    
33.             If xItem.Tag = Item.Text Then ListView2.ListItems.Remove (xItem.Index)
    
34.         Next
    
35.     End If
    
36. End Sub
    
37. 
    
38. Private Sub UserForm_Initialize()
    
39.     Dim key$, Item As MSComctlLib.ListItem
    
40.     arr = Sheet2.Range("A1").CurrentRegion
    
41.     ListView1.ColumnHeaders.Add , , "业务大类", ListView1.Width - 15
    
42.     For i = 2 To UBound(arr)
    
43.         If Trim(arr(i, 1)) <> "" Then
    
44.             Set Item = ListView1.ListItems.Add
    
45.             Item.Text = Trim(arr(i, 1))
    
46.             Item.Tag = Trim(arr(i, 2))     '若每类的产品多可能出现错误
    
47.         Else
    
48.             Item.Tag = Item.Tag & "|" & Trim(arr(i, 2))
    
49.         End If
    
50.     Next
    
51.     ListView2.ColumnHeaders.Add , , "产品名称", ListView2.Width - 15
    
52.     Sheet1.Select
    
53. End Sub
    

复制代码

一指禅62

对 ListView 有兴趣的同学可参考 http://club.excelhome.net/thread-703775-1-1.html

fighter222

一指禅62 发表于 2017-12-19 16:48
对 ListView 有兴趣的同学可参考 http://club.excelhome.net/thread-703775-1-1.html

太感谢了，完美实现！我好好研究下

fighter222

一指禅62 发表于 2017-12-19 16:48
对 ListView 有兴趣的同学可参考 http://club.excelhome.net/thread-703775-1-1.html

尝试了listview，通用性比较差，我自己的机器注册控件弄了好久，换台机器又不行了。