多级(不限级数)联动下拉菜单源码分享

yimi8 · 发表于 2019-6-8 13:08

想学学，谢谢分享，我是用2003版，能打开吗？

我是来讨说法的 · 发表于 2019-6-10 11:41

yimi8 发表于 2019-6-8 13:08
想学学，谢谢分享，我是用2003版，能打开吗？

2003》》》》》》》》》》》》

yimi8 · 发表于 2019-6-12 12:14

我是来讨说法的发表于 2019-6-10 11:41
2003》》》》》》》》》》》》

多谢老师了，下载学习一下。

Yoon1224 · 发表于 2019-8-16 12:10

学习了，谢谢分享

jkyjin · 发表于 2019-9-10 10:28

感谢大神的分享，但我的表格有15列，如何添加呢，到第五列就不行了。

pipsi · 发表于 2019-9-21 14:17

感谢分享，学习学习。

dengcaimao · 发表于 2019-12-4 13:12

正是想要的，下来试试，谢谢

YZC51 · 发表于 2019-12-4 13:36

我是来讨说法的发表于 2019-6-10 11:41
2003》》》》》》》》》》》》

谢谢老师分享优秀作品！
学习下，老师的代码。
'菜单数据随区域大小自动修改
'自动下拉不用点选箭头。

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim ML As New multilevel
Dim s As String, i As Integer
ML.DataList = Sheet3.[a2].CurrentRegion.Value '菜单数据随区域大小自动修改
If Target.Column = 1 Then
Application.SendKeys "%{down}" '自动下拉不用点选箭头。
ML.Lists Target
Else
Application.SendKeys "%{down}" '自动下拉不用点选箭头。
For i = 1 To Target.Column - 1
      If Cells(Target.Row, i) <> "" Then
         If s = "" Then
            s = Cells(Target.Row, i)
         Else
            s = s & "," & Cells(Target.Row, i)
         End If
      Else
'          MsgBox "上级菜单不能为空"
         Exit Sub
      End If
Next
ML.Lists Target, s
End If
End Sub

YZC51 · 发表于 2019-12-4 13:37

附件参考

无限极下拉菜单展示 (2).zip (18.52 KB, 下载次数: 127)

苏钊丶 · 发表于 2019-12-21 08:57

很不错的东西！！

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

[分享] 多级(不限级数)联动下拉菜单源码分享