右键树型菜单

笑着...两年过去 · 发表于 2013-11-25 11:12

jsxjd 发表于 2013-11-25 10:40
把原来的菜单都删除吗？

k = d.keys

是这个意思，
不过好像不对咧

jsxjd · 发表于 2013-11-25 11:20

复制代码

jsxjd · 发表于 2013-11-25 11:22

笑着...两年过去发表于 2013-11-25 11:12
是这个意思，
不过好像不对咧

如 22楼添加一行代码，注释掉 .Reset

笑着...两年过去 · 发表于 2013-11-25 11:26

本帖最后由笑着...两年过去于 2013-11-25 11:27 编辑

苍海拾贝发表于 2013-11-25 11:01
把.reset..........for 之间不需要显示的菜单项对应的代码删除，试试

……………………

苍海拾贝 · 发表于 2013-11-25 15:27

笑着...两年过去发表于 2013-11-25 11:26
……………………

有误，重发，新建一个菜单

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

zhaogang1960 · 发表于 2013-11-25 15:43

本帖最后由 zhaogang1960 于 2013-11-25 15:47 编辑

提高速度改进：
一、昨天用了两个字典，都使用了字典嵌套，菜单有些迟缓，今天试着去掉第二个字典，用字典条目Items来代替第二个字典，以达到加快速度的目的
二、加进了各位的改进

Sub CreatMe() '生成右键菜单
Dim d As Object, i&, j&, k, k2, t, a, l&, arr, x As Object
Set d = CreateObject("scripting.dictionary")
arr = Sheets("Sheet1").Range("A1").CurrentRegion
For i = 2 To UBound(arr)
If Not d.Exists(arr(i, 1)) Then Set d(arr(i, 1)) = CreateObject("scripting.dictionary")
If Len(arr(i, 2)) Then d(arr(i, 1))(arr(i, 2)) = d(arr(i, 1))(arr(i, 2)) & "," & arr(i, 3)
Next
k = d.keys '一级分类
With Application.CommandBars("cell")
For Each x In .Controls '删除所有菜单项
x.Delete
Next
For i = 0 To UBound(k)
With .Controls.Add(Type:=IIf(d(k(i)).Count, msoControlPopup, msoControlButton))
.Caption = k(i)
.OnAction = IIf(d(k(i)).Count, "", "'显示在活动单元格 """ & k(i) & """'")
.BeginGroup = True '分组显示
k2 = d(k(i)).keys '二级分类
t = d(k(i)).items '三级分类，每个三级分类用逗号隔开
For j = 0 To UBound(k2)
a = Split(t(j), ",")
With .Controls.Add(Type:=IIf(Len(t(j)) > UBound(a), msoControlPopup, msoControlButton))
.Caption = k2(j)
.OnAction = IIf(Len(t(j)) > UBound(a), "", "'显示在活动单元格 """ & k2(j) & """'")
For l = 1 To UBound(a)
If Len(a(l)) Then
With .Controls.Add(Type:=msoControlButton)
.Caption = a(l)
.OnAction = "'显示在活动单元格 """ & a(l) & """'"
End With
End If
Next
End With
Next
End With
Next
End With
End Sub

复制代码

zhaogang1960 · 发表于 2013-11-25 15:48

请看附件

临时文件g3.rar (48.03 KB, 下载次数: 89)

笑着...两年过去 · 发表于 2013-11-25 17:11

zhaogang1960 发表于 2013-11-25 15:48
请看附件

这右键太难学了，没年把的功夫吸收不了啊，左键应该简单多了哈，再做一个好吗

zhaogang1960 · 发表于 2013-11-25 17:14

还有一个提速方法
激活Sheet2时把Sheet1数据写进字典，右键单击时只生成菜单，不用再计算一遍Sheet1数据了

zhaogang1960 · 发表于 2013-11-25 17:19

笑着...两年过去发表于 2013-11-25 17:11
这右键太难学了，没年把的功夫吸收不了啊，左键应该简单多了哈，再做一个好吗

不会吧，我这是第一次写右键菜单，不过确实叫我苦思冥想了一番

没有听说过左键菜单，即使有生成菜单的语句也应该是一样的

可以单击左键出现一个窗体，窗体中用3个列表框来模拟菜单，不过似乎没有意义

		自动登录	找回密码
密码			免费注册

[求助] 右键树型菜单