ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
300集Office 2010微视频教程 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
楼主: cunfu2010

[求助] 利用VBA制作下拉多级菜单

  [复制链接]

TA的精华主题

TA的得分主题

发表于 2017-9-14 00:35 | 显示全部楼层
huang1314wei 发表于 2016-3-20 23:01
可以呀,很简单,你把省市区一个一个手动输入到一个数组当中就行了,我用辅助表就是不想一个一个输入,方 ...

谢谢共享!
太棒!!!!!
如果不需要写什么代码?

TA的精华主题

TA的得分主题

发表于 2017-10-10 22:30 | 显示全部楼层
怎么实现在不同的列中显示弹出的菜单呢

TA的精华主题

TA的得分主题

发表于 2017-10-17 15:52 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
不段的学习,不段的成长。

TA的精华主题

TA的得分主题

发表于 2018-2-3 11:29 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2018-4-9 15:14 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2018-5-1 11:12 | 显示全部楼层
huang1314wei 发表于 2016-3-19 20:18
楼主,你看一下你是要这个效果吗?

下载过来了,里面好多语句都第一次看到,得慢慢学习

TA的精华主题

TA的得分主题

发表于 2018-6-10 20:33 | 显示全部楼层
Sub main()    '根据数据表初始化弹出菜单
On Error Resume Next

Dim data
Dim nrows, ncols

'读入源数据
data = Range("扣分表!a1").CurrentRegion.Value    '定位源数据区,源数据放入数组data
nrows = UBound(data, 1)
ncols = UBound(data, 2)
ReDim Preserve data(1 To nrows, 1 To ncols)

Call 快捷菜单(data, nrows, ncols, "qlbh") '生成桥梁病害的快捷菜单

End Sub

Sub 快捷菜单(data, nrows, ncols, cbarName) '源数据,源数据行数,源数据列数,commandbar名
On Error Resume Next
Dim preMenuKey
Dim curMenuName
Dim curMenuCaption

Application.CommandBars(cbarName).Delete    '重设菜单前删除commandbar
Set cbar = Application.CommandBars.Add(Name:=cbarName, position:=msoBarPopup)   '创建弹出式菜单

'创建字典,并指定key和相应的item,item为commandbar对象
Set zd = CreateObject("Scripting.Dictionary")    '目录树存储每个菜单
zd.Add cbarName, cbar

For i = 2 To nrows
preMenuKey = cbarName

    For j = 1 To ncols
      
'        preMenuKey = preMenuKey
        If data(i, j) <> "" Then
            curMenuKey = preMenuKey & "\" & data(i, j)
            curMenuCaption = data(i, j)
        End If
         
        If Not zd.exists(curMenuKey) Then
            If j = ncols Then
                Call AddControl(zd, preMenuKey, curMenuKey, curMenuCaption, i, 1) '1为msocontrolbutton
            ElseIf data(i, j + 1) = "" Then
                Call AddControl(zd, preMenuKey, curMenuKey, curMenuCaption, i, 1) '1为msocontrolbutton
            Else
                Call AddControl(zd, preMenuKey, curMenuKey, curMenuCaption, i, 2)  '1为msocontrolbutton
            End If
        End If
        
        preMenuKey = curMenuKey

            
    Next j
   
Next i
   
Set cbar = Nothing

End Sub

'添加菜单命令
Sub AddControl(ByVal zd, ByVal preMenuKey$, ByVal curMenuKey$, ByVal curMenuCaption$, ByVal i&, ByVal menuType$)
    Dim bar
    Select Case menuType
        Case 1 'msoControlButton
            Set bar = zd(preMenuKey).Controls.Add(Type:=msoControlButton)
            bar.OnAction = "'WriteToRng " & i & "'" '最后一级选择触发事件,完成输入
        Case 2 'msoControlPopup
            Set bar = zd(preMenuKey).Controls.Add(Type:=msoControlPopup)
    End Select
   
    bar.caption = curMenuCaption    '菜单按钮名称
    zd.Add curMenuKey, bar '加入字典以供下级菜单索引节点
   
    Set bar = Nothing
End Sub

TA的精华主题

TA的得分主题

发表于 2018-8-23 20:05 | 显示全部楼层

您好 请问64位win10+32位OFFICE2016显示不正常,加号(+)无法展开是什么怎么回事? 号无法展开.png

TA的精华主题

TA的得分主题

发表于 2018-9-7 07:40 | 显示全部楼层
huang1314wei 发表于 2016-3-19 21:02
附件在这里,代码借鉴了论坛一位前辈,加上自己修改了部分代码

多级联动菜单一次性输入

你好,我想请问一下,如果多级联动菜单不想从A列开始,应该更改哪些地方

TA的精华主题

TA的得分主题

发表于 2018-10-21 23:13 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
huang1314wei 发表于 2016-3-20 22:35
如果是这样的话,你用2楼提供的链接,使用zhaogang老师的教程,采用treeview控件,实现多级联通,更方便
...

厉害!!!
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2024-3-28 23:23 , Processed in 0.063960 second(s), 8 queries , Gzip On, Redis On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

快速回复 返回顶部 返回列表