右键树型菜单

笑着...两年过去

zhaogang1960 发表于 2013-11-25 17:19
不会吧，我这是第一次写右键菜单，不过确实叫我苦思冥想了一番

没有听说过左键菜单，即使有生成菜单的 ...

额，我不懂所以叫法不对，反正差不多右键的那个效果，您懂的

zhaogang1960

笑着...两年过去 发表于 2013-11-25 17:23
额，我不懂所以叫法不对，反正差不多右键的那个效果，您懂的

左键右键应该没有实际差别，还是先研究进一步提速吧：

1. Dim d As Object '声明为模块级变量
   
2. 
   
3. Sub CreatMe() '生成右键菜单
   
4.     Dim i&, j&, k, k2, t, a, l&, arr, x As Object
   
5.     If d Is Nothing Then Call 设置字典 '为了防止意外，判断一下字典是否存在，如果不存在则设置字典
   
6.     k = d.keys '一级分类
   
7.     With Application.CommandBars("cell")
   
8.         For Each x In .Controls '删除所有菜单项
   
9.             x.Delete
   
10.         Next
    
11.         For i = 0 To UBound(k)
    
12.             With .Controls.Add(Type:=IIf(d(k(i)).Count, msoControlPopup, msoControlButton))
    
13.                 .Caption = k(i)
    
14.                 .OnAction = IIf(d(k(i)).Count, "", "'显示在活动单元格 """ & k(i) & """'")
    
15.                 .BeginGroup = True '分组显示
    
16.                 k2 = d(k(i)).keys '二级分类
    
17.                 t = d(k(i)).items '三级分类，每个三级分类用逗号隔开
    
18.                 For j = 0 To UBound(k2)
    
19.                     a = Split(t(j), ",")
    
20.                     With .Controls.Add(Type:=IIf(Len(t(j)) > UBound(a), msoControlPopup, msoControlButton))
    
21.                         .Caption = k2(j)
    
22.                         .OnAction = IIf(Len(t(j)) > UBound(a), "", "'显示在活动单元格 """ & k2(j) & """'")
    
23.                         For l = 1 To UBound(a)
    
24.                             If Len(a(l)) Then
    
25.                                 With .Controls.Add(Type:=msoControlButton)
    
26.                                     .Caption = a(l)
    
27.                                     .OnAction = "'显示在活动单元格 """ & a(l) & """'"
    
28.                                 End With
    
29.                             End If
    
30.                         Next
    
31.                     End With
    
32.                 Next
    
33.             End With
    
34.         Next
    
35.     End With
    
36. End Sub
    
37. 
    
38. Sub 设置字典()
    
39.     Set d = CreateObject("scripting.dictionary")
    
40.     arr = Sheets("Sheet1").Range("A1").CurrentRegion
    
41.     For i = 2 To UBound(arr)
    
42.         If Not d.Exists(arr(i, 1)) Then Set d(arr(i, 1)) = CreateObject("scripting.dictionary")
    
43.         If Len(arr(i, 2)) Then d(arr(i, 1))(arr(i, 2)) = d(arr(i, 1))(arr(i, 2)) & "," & arr(i, 3)
    
44.     Next
    
45. End Sub
    

复制代码

1. Private Sub Worksheet_Activate() '激活Sheet2时设置字典
   
2.     Call 设置字典
   
3. End Sub

复制代码

1. Private Sub Workbook_Activate() 'ThisWorkbook代码区，激活本工作簿，活动工作表是Sheet2则设置字典
   
2.     If ActiveSheet.Name = "Sheet2" Then Call 设置字典
   
3. End Sub
   

复制代码

zhaogang1960

请测试附件
临时文件(提前设置字典).rar (48.65 KB, 下载次数: 320)

2013-11-25 17:31 上传

点击文件名下载附件

苍海拾贝

苍海拾贝 发表于 2013-11-25 15:27
有误，重发，新建一个菜单

改了个左键的，请测试，原来的速度确实比赵版的慢很多，主要原因应该是每次点击都要创建菜单试试预先创建菜单，点击时执行showpopup，供参考



临时文件20131125.rar (48.77 KB, 下载次数: 109)

2013-11-25 17:47 上传

点击文件名下载附件

zhaogang1960

笑着...两年过去 发表于 2013-11-25 17:23
额，我不懂所以叫法不对，反正差不多右键的那个效果，您懂的

激活Sheet2时生成左键树型菜单，Sheet2出于非活动状态时删除它，当你单击F列的某一个单独的单元格时显示左键树型菜单，离开时不显示，速度很快：

1. Sub CreatMe() '生成左键树型菜单
   
2.     Dim d As Object, i&, j&, k, k2, t, a, l&, arr, x As Object
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     arr = Sheets("Sheet1").Range("A1").CurrentRegion
   
5.     For i = 2 To UBound(arr)
   
6.         If Not d.Exists(arr(i, 1)) Then Set d(arr(i, 1)) = CreateObject("scripting.dictionary")
   
7.         If Len(arr(i, 2)) Then d(arr(i, 1))(arr(i, 2)) = d(arr(i, 1))(arr(i, 2)) & "," & arr(i, 3)
   
8.     Next
   
9.     k = d.keys '一级分类
   
10.     On Error Resume Next
    
11.     Application.CommandBars("树型菜单").Delete '删除可能存在的
    
12.     With Application.CommandBars.Add("树型菜单", msoBarPopup)
    
13.         For i = 0 To UBound(k)
    
14.             With .Controls.Add(Type:=IIf(d(k(i)).Count, msoControlPopup, msoControlButton))
    
15.                 .Caption = k(i)
    
16.                 .OnAction = IIf(d(k(i)).Count, "", "'显示在活动单元格 """ & k(i) & """'")
    
17.                 .BeginGroup = True '分组显示
    
18.                 k2 = d(k(i)).keys '二级分类
    
19.                 t = d(k(i)).items '三级分类，每个三级分类用逗号隔开
    
20.                 For j = 0 To UBound(k2)
    
21.                     a = Split(t(j), ",")
    
22.                     With .Controls.Add(Type:=IIf(Len(t(j)) > UBound(a), msoControlPopup, msoControlButton))
    
23.                         .Caption = k2(j)
    
24.                         .OnAction = IIf(Len(t(j)) > UBound(a), "", "'显示在活动单元格 """ & k2(j) & """'")
    
25.                         For l = 1 To UBound(a)
    
26.                             If Len(a(l)) Then
    
27.                                 With .Controls.Add(Type:=msoControlButton)
    
28.                                     .Caption = a(l)
    
29.                                     .OnAction = "'显示在活动单元格 """ & a(l) & """'"
    
30.                                 End With
    
31.                             End If
    
32.                         Next
    
33.                     End With
    
34.                 Next
    
35.             End With
    
36.         Next
    
37.     End With
    
38. End Sub

复制代码

1. Sub DeleteMycell() '删除左键菜单
   
2.     On Error Resume Next
   
3.     Application.CommandBars("树型菜单").Delete
   
4. End Sub
   

复制代码

1. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   
2.     If Target.Count > 1 Then Exit Sub
   
3.     If Target.Column = 6 Then Application.CommandBars("树型菜单").ShowPopup
   
4. End Sub
   
5. 
   
6. Private Sub Worksheet_Activate() '激活Sheet2时生成左键树型菜单
   
7.     Call CreatMe
   
8. End Sub
   
9. 
   
10. Private Sub Worksheet_Deactivate() '离开Sheet2时删除左键树型菜单，防止影响其他工作表
    
11.     Call DeleteMycell
    
12. End Sub
    

复制代码

zhaogang1960

请看附件：
临时文件(激活Sheet2时生成左键树型菜单).rar (49.47 KB, 下载次数: 376)

2013-11-25 19:10 上传

点击文件名下载附件

name004

zhaogang1960 发表于 2013-11-25 17:14
还有一个提速方法
激活Sheet2时把Sheet1数据写进字典，右键单击时只生成菜单，不用再计算一遍 ...

赵老师确实是师德高，技术高。
这个问题，如果这样解决，太麻烦了，让人望而却步。
我说说我前几年的解决方法:双击f列，双击事件激活sheet1并且选择在a列；a列双击则选择b列对应行。以此类推，连锁双击和选择。
比如：计算机配件销售，品种实在多得吓人，用右键如何涵盖几十个品种？而且，字体很小，选择中紧紧抓住鼠标且对应光标。很累！
临时文件的附件速度很快，确实很好。

zhaogang1960

name004 发表于 2013-11-25 22:25
赵老师确实是师德高，技术高。
这个问题，如果这样解决，太麻烦了，让人望而却步。
我说说我前几年的解 ...

你说的倒也是个办法，可以避免因数据太多，字典存放不下

如果数据不是很多，楼主要求的这个方法还是可行的，可以免去两个工作表来回激活带来的麻烦

zjisy

赵老师强大，请问赵老师，临时文件(提前设置字典)四级分类显示最后两个单元格怎么做到呢？就是选到最后，显示出三级和四级单元格内的内容。

zjisy

zhaogang1960 发表于 2013-11-25 22:34
你说的倒也是个办法，可以避免因数据太多，字典存放不下

如果数据不是很多，楼主要求的这个方法还是可 ...

赵老师强大，请问赵老师，临时文件(提前设置字典)四级分类显示最后两个单元格怎么做到呢？
http://club.excelhome.net/thread-1074700-4-1.html