|
楼主 |
发表于 2020-3-10 06:51
|
显示全部楼层
Sub 创建菜单()
Dim d As Object, i&, j&, k, k2, t2, a3, l&, arr
Set d = CreateObject("scripting.dictionary")
arr = Sheets("食品分类").Range("K3").CurrentRegion
For i = 2 To UBound(arr)
For j = 1 To 3
If Len(arr(i, j)) = 0 Then arr(i, j) = arr(i - 1, j)
Next
s = arr(i, 1)
If InStr(d(s) & ",", "," & arr(i, 2) & ",") = 0 Then d(s) = d(s) & "," & arr(i, 2) '字典键值是一级菜单,字典条目是二级菜单
For j = 2 To 3 '从第二级到倒数第二级菜单用循环实现
s = s & vbTab & arr(i, j)
If InStr(d(s) & ",", "," & arr(i, j) & ",") = 0 Then d(s) = d(s) & "," & arr(i, j + 1) '字典条目是j+1级菜单
Next
Next
k = Filter(d.Keys, vbTab, False) '一级分类
On Error Resume Next
Application.CommandBars("临时菜单").Delete '删除可能存在的"临时菜单"菜单
With Application.CommandBars.Add("临时菜单", msoBarPopup)
For i = 0 To UBound(k)
t2 = d(k(i)) '二级分类,每个二级分类用逗号隔开
a2 = Split(t2, ",") '二级分类数组
With .Controls.Add(Type:=msoControlPopup) '二级分类
.Caption = k(i)
.BeginGroup = True '分组显示
For j = 1 To UBound(a2) '逐个二级分类
t3 = d(k(i) & vbTab & a2(j)) '三级分类,每个三级分类用逗号隔开
a3 = Split(t3, ",") '三级分类数组
With .Controls.Add(Type:=msoControlPopup)
.Caption = a2(j)
For l = 1 To UBound(a3)
t4 = d(k(i) & vbTab & a2(j) & vbTab & a3(l)) '四级分类,每个四级分类用逗号隔开
a4 = Split(t4, ",") '四级分类数组
With .Controls.Add(Type:=msoControlPopup)
.Caption = a3(l)
For v = 1 To UBound(a4)
If Len(a4(v)) Then
With .Controls.Add(Type:=msoControlButton) '创建四级菜单
.Caption = a4(v)
.OnAction = "'显示在活动单元格 """ & k(i) & Chr(9) & a2(j) & Chr(9) & a3(l) & Chr(9) & .Caption & """'"
End With
End If
Next v
End With
Next l
End With
Next j
End With
Next i
End With
End Sub
Sub 显示在活动单元格(s$)
ActiveCell.Resize(, 4) = Split(s, Chr(9))
End Sub
Sub 删除菜单()
On Error Resume Next
Application.CommandBars("临时菜单").Delete
End Sub
用这个 怎么不出来啊 |
|