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

yimi8

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

我是来讨说法的

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

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

yimi8

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

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

Yoon1224

学习了，谢谢分享

jkyjin

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

pipsi

感谢分享，学习学习。

dengcaimao

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

YZC51

我是来讨说法的 发表于 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

附件参考
无限极下拉菜单展示 (2).zip (18.52 KB, 下载次数: 124)

2019-12-4 13:37 上传

点击文件名下载附件

苏钊丶

很不错的东西！！