[已解决]自定义工具栏如何设置多级下拉菜单

c888 · 发表于 2016-5-25 09:48

本帖最后由 c888 于 2016-5-26 12:37 编辑

附件在第2楼，谢谢大家！

最佳答案

月排行榜 / 总排行榜

zjdh

2016-5-26 10:53

本帖最后由 zjdh 于 2016-5-26 10:56 编辑

多级下拉菜单.rar (21.88 KB, 下载次数: 51)

c888 · 发表于 2016-5-25 09:50

谢谢老师指导！

自定义工具栏设置多级下拉菜单.zip (27.55 KB, 下载次数: 30)

c888 · 发表于 2016-5-25 16:07

c888 发表于 2016-5-25 09:50
谢谢老师指导！

请问老师能否实现第3级下拉菜单。谢谢！

zjdh · 发表于 2016-5-25 17:18

多级菜单范例.rar (10.28 KB, 下载次数: 27)

zjdh · 发表于 2016-5-25 18:31

其实你2楼的附件中那么多的语句可以简化如下：
Private Sub Workbook_Open()
On Error Resume Next
Application.CommandBars("自定义工具栏").Delete
With Application.CommandBars.Add("自定义工具栏", msoBarTop)
      With .Controls.Add(msoControlPopup)
         .Caption = "竞赛项目"
         Set d = CreateObject("scripting.dictionary")
         arr = Sheet2.UsedRange
         For i = 2 To UBound(arr)
            If arr(i, 2) = "" Then Exit For
            If Not d.exists(arr(i, 2)) Then  '
                  .Controls.Add(msoControlPopup).Caption = arr(i, 2)
                  d(arr(i, 2)) = ""
            End If
            If Not d.exists(arr(i, 2) & arr(i, 3)) Then
                  With .Controls(arr(i, 2)).Controls.Add(msoControlButton)
                     .Caption = arr(i, 3)
                     .OnAction = arr(i, 3)
                  End With
                  d(arr(i, 2) & arr(i, 3)) = ""
            End If
         Next
         Set d = Nothing
      End With
      With .Controls.Add(msoControlPopup)
         .Caption = "关闭系统"
         With .Controls.Add(msoControlButton)
            .Caption = "关闭系统"
            .OnAction = "关闭系统"
         End With
      End With
      .Visible = True
End With
End Sub

zjdh · 发表于 2016-5-25 18:59

本帖最后由 zjdh 于 2016-5-26 10:43 编辑

自定义工具栏设置多级下拉菜单.rar (22.84 KB, 下载次数: 18)

zjdh · 发表于 2016-5-26 10:53

本帖最后由 zjdh 于 2016-5-26 10:56 编辑

多级下拉菜单.rar (21.88 KB, 下载次数: 51)

zjdh · 发表于 2016-5-26 14:49

楼上附件还存在一个缺点，关闭文件时未将自定义菜单删除。

多级下拉菜单.rar (20.81 KB, 下载次数: 32)

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

[已解决]自定义工具栏如何设置多级下拉菜单

相关帖子

浏览过的版块