036-创建多级下拉菜单-疑难千寻千解丛书（VBA）

小妖 · 发表于 2011-2-21 10:15

ET疑难千寻千解丛书之EXCEL2010编程与实践

罗刚君章兰新黄朝阳编著

疑难36
如何引用数据表创建多级下拉菜单

数据有效性可以实现下拉菜单，但只能一级。那么可以实现二级菜单吗?例如利用图所示的数据

产生如图所示的二级菜单，当单击单元格时，产生二级菜单；选择第二级菜单时可以在单元格分别产生部门和姓名，即同时输入一级和二级菜单的字符。

è解决方案

数据有效性功能无法修改，但可以通过自定义二级菜单的方式来处理。ShowPopup方法可以将二级菜单显示在活动单元格处，从而打造出类似于数据有效性下拉列表的二级菜单。最后利用ActionControl属性获取用户所单击的菜单字符，并导入到单元格中。

简单而言，就是利用工作簿事件SheetSelectionChange，在选择指定的单元格时利用CommandBars.Add创建一级和二级菜单，而当用户选择菜单时，将菜单的文字标题导入到单元格中。

í操作方法

步骤1
按【Alt+F11】组合键打开VBE窗口。

步骤2
选择菜单“插入”→“模块”，并输入以下代码：

Sub 选项() '用于指定哪个区域可以产生二级菜单
Dim i As String, adds As String, sht As Worksheet
'确认是否存在“数据”工作表
On Error Resume Next
Set sht = Sheets("数据")
If err.Number <> 0 Then MsgBox "请建立一个名为“数据”的工作表，用于存放菜单
所需要的数据", , "确认数据表": GoTo err
err.Clear
On Error GoTo err
'如果选择的是单元格，那么将选区地址赋予变量adds，否则将“B:B”赋予变量
If TypeName(Selection) = "Range" Then adds = Selection.Address(0, 0) Else
adds = "B:B"
i = Application.InputBox("你想控制哪一个区域" & vbCrLf & "如果想关闭本功能，
单击取消按钮即可。", "请选择区域", adds, , , , , 8).Address(0, 0)
SaveSetting "MyApp", "only", "only", i '将用户选择的单元格地址存入注册表
Exit Sub '退出程序
err:
SaveSetting "MyApp", "only", "only", "" '在注册表中写入一个空字符
End Sub
以上过程用于让用户指定在哪个区域产生二级菜单，可以利用【Ctrl】键多选。而用户选择的区域地址将会存储在注册表中。
步骤3 如果VBE编辑器左边没有对象浏览器，那么选择菜单“视图”→“对象浏览器”调出对象浏览器窗口。然后双击“ThisWorkbook”进入代码窗口，并输入以下工作簿级别事件过程代码：
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
If GetSetting("MyApp", "only", "only", "") = "" Then Exit Sub
'如果注册表中没有值则退出
If Target.Count > 1 Then Exit Sub '如果选择区域则退出
On Error Resume Next
Dim sht As Worksheet
Set sht = Sheets("数据") '将数据表赋予变量sht
If err <> 0 Then err.Clear: Exit Sub
'如果有错误（即没有“数据”工作表）那么退出
If sht.Range("a1") = "" Then MsgBox "请在数据表中输入数据，必须从A1开始，数
据区不要留空", vbOKOnly, "提示": Exit Sub
Dim a As Range
'判断注册表中记录的单元格与活动单元格是否重叠
Set a = Intersect(Range(GetSetting("MyApp", "only", "only", "")),
ActiveCell)
If a Is Nothing Then Exit Sub '如果不在指定区域则退出
Dim i, j, addss As String
With Application.CommandBars.Add("临时菜单", msoBarPopup, , 1)
'创建一个快捷菜单
With .Controls.Add(Type:=msoControlButton) '添加一个子菜单
.Caption = "请选择" '指定显示标题
.FaceId = 136 '指定图标
End With
For i = 1 To sht.Cells(1, Columns.Count).End(xlToLeft).Column
'创建一级菜单
If WorksheetFunction.CountA(sht.Rows(2)) = 0 Then
'如果第二行为空则只创建一级菜单
With .Controls.Add(Type:=msoControlButton) '开始创建一级菜单
.Caption = sht.Cells(1, i).Text '菜单显示的标题
.Style = msoButtonIconAndCaption '同时显示文本和图标
.FaceId = 70 + i '指定图文件
.OnAction = "输入" '指定菜单对应的宏名
End With
Else '第二行非空则创建二级菜单
With .Controls.Add(msoControlPopup, 1, , , 1) '开如创建二级菜单
.BeginGroup = True '全部产生一条横线分隔开
.Caption = sht.Cells(1, i).Text '指定二级菜单标题
For j = 2 To sht.Cells(Rows.Count, i).End(xlUp).Row
If sht.Cells(j, i) = "" Then GoTo AA '如果为空则不创建子菜单
Set oCtrl = .Controls.Add(Type:=msoControlButton) '创建子菜单
With oCtrl '对子菜单指定标题、宏名和图标
.Caption = sht.Cells(j, i)
.OnAction = "输入"
.FaceId = 69 + j
End With
AA:
Next
End With
End If
Next
.ShowPopup '显示工具栏
End With
Application.CommandBars("临时菜单").Delete '删除工具栏
End Sub

复制代码

小妖 · 发表于 2011-2-21 10:15

以上事件为工作簿级别的SelectionChange事件，表示用户选择单元格时执行对应的过程。本过程首先判断当前选区是否与注册表中存储的单元格重叠，如果重叠则创建二级菜单，调用“数据”工作表中指定区域的文本作为菜单的显示标题。

步骤4
返回模块中，继续输入过程“输入”的代码：

Sub 输入() '当单击二级菜单时，将菜单的标题字符写入单元格
AA = CommandBars.ActionControl.Caption '记录当前菜单的标题
'在数据表中查找变量aa，并返回找到的目标所在列的第一个单元格（即一级菜单），并写入
'活动单元格
ActiveCell = Sheets("数据").Cells.Find(What:=AA, LookAt:=xlWhole). EntireColumn.Cells(1)
'如果“数据”工作表第二行有数据，那么将当前菜单的文字写入右边一个单元格（即二级菜单）
If WorksheetFunction.CountA(Sheets("数据").Rows(2)) <> 0 Then
ActiveCell.Offset(0, 1) = AA
End If
End Sub

复制代码

以上过程是单击菜单时执行的宏过程，用于将一级和二级菜单的显示标题导出到活动单元格及活动单元格右边一个单元格。如果只有一级菜单，则只导入一级菜单的文字。

步骤5
返回工作表界面，在“数据”工作表中按图所示方式输入数据。其中第一行用于创建一级菜单，其他数据用于创建二级菜单；在区域中间不能有空白单元格。

步骤6
切换到“职工表”，选择“开发工具”选项卡，单击【宏】按钮，在弹出的对话框中选择过程名“选项”并单击【执行】按钮，程序会弹出对话框等待用户指定需要产生二级菜单的区域，如图所示。选择一个或者多个区域，程序会将地址保存在注册表中。

步骤7
单击B2:B10区域中任意单元格，将弹出上图所示的二级菜单。如果选择菜单“业务部”→“胡大链”，那么B列和C列同时产生“业务部”和“胡大链”，如图所示。

步骤8
切换到“数据”工作表，将第一行以外的数据删除。返回“职工表”，选择B4单元格，此时将弹出一级菜单，如图所示。

步骤9
切换到“数据”工作表，恢复删除前的所有数据，并且在E列追加部门“策划部”和姓名“胡军”、“张英姿”。进入“职工表”，选择B2单元格，在弹出的菜单中也自动追加对应的二级菜单，如图所示。

=============================

以上摘自《EXCEL2010编程与实践》

静s听w风q雨 · 发表于 2011-2-21 10:36

最好老师能做个插件或加载的宏，我不知道怎么弄啊

yishuihanab · 发表于 2011-2-23 12:14

有点复杂

wentan17 · 发表于 2011-2-23 11:07

非常复杂。

UNA123 · 发表于 2011-4-9 20:58

{:011:}{:011:}{:011:}{:011:}

zjht · 发表于 2011-4-20 15:55

我就直接没看懂！太复杂了啊！

cyt381828864 · 发表于 2011-5-26 12:53

没看懂但还是顶一下，不知道什么时候才可以学习VBA呢？

无聊的疯子 · 发表于 2011-5-24 20:46

好贴~~值得学习和研究！

babytyt · 发表于 2012-3-10 20:25

感谢管理员小妖老师，十分详细，解决了我大问题，还有一点想请教，1、若设定控制区域为B列，所有的工作表B列都会出现二级菜单，若不想这样，有办法解决吗？2、若加入三级菜单该如何写代码，盼指点，谢谢，附件已经上传

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

[VBA] 036-创建多级下拉菜单-疑难千寻千解丛书（VBA）

本帖子中包含更多资源

本帖子中包含更多资源

本帖子中包含更多资源