VBA制作下拉菜单的问题

cp121ok

各位，请教下如何将这种下拉菜单（见附件）




改为这种

liulang0808

论坛里这个，楼主搜索吧，使用了控件

cp121ok

liulang0808 发表于 2017-12-19 11:00
论坛里这个，楼主搜索吧，使用了控件

论坛里有，我也找到了，太复杂，都是些多级联动的，太复杂了，没看懂。。。。。
大神能帮忙在我这个附件里改下吗，实现这个效果，我好研究下，谢谢了！

jiaxinl

cp121ok 发表于 2017-12-19 11:21
论坛里有，我也找到了，太复杂，都是些多级联动的，太复杂了，没看懂。。。。。
大神能帮忙在我这个附件 ...

用的是右键的快捷菜单
代码如下：

Sub 快捷菜单()
Dim arr, MyPopup As CommandBar, r&, j&
r = Sheet1.Cells(Rows.Count, "B").End(xlUp).Row
If r = 1 Then Exit Sub
arr = Sheet1.Range("B2:B" & r) 'Sheet1工作表中单元格赋值给数组
On Error Resume Next   '遇到错误时继续执行下面的语句
Application.CommandBars("我的菜单").Delete '删除"我的菜单"
Set MyPopup = Application.CommandBars.Add(Name:="我的菜单", Position:=msoBarPopup, temporary:=True)
With MyPopup
  For j = 1 To UBound(arr)
    With .Controls.Add(temporary:=True) '创建"我的菜单"项目
      .Caption = arr(j, 1) '创建"我的菜单" 中 菜单项目名
      .OnAction = "'菜单项""" & j & """ '"  '创建菜单项对应的宏
    End With
  Next j
End With
Set MyPopup = Nothing '释放我的菜单
End Sub

Sub 菜单项(x)  '循环做菜单项的过程
Dim S As String
  S = Application.CommandBars.ActionControl.Caption '单击 创建"我的菜单" 中 菜单项目名
  ActiveCell = S '赋值给活动单元格
  '以下为每个菜单项编写子过程,只显示一个提示信息对话框,不编写具体操作的代码
  '在实际应用中,应在这些子过程中编写具体的代码
  'MsgBox "你选择的是 菜单项" & x, vbInformation + vbOKOnly, "工作表菜单项及子菜单"
  ''MsgBox "你选择了：" & Application.CommandBars.ActionControl.Caption, vbInformation + vbOKOnly, "工作表菜单项及子菜单"
End Sub

Sub 删除快捷菜单()
Application.CommandBars("我的菜单").Delete
End Sub


ThisWorkbook

Private Sub Workbook_Open()  '工作表打开事件
  Call 快捷菜单  '在打开档案时，创建新的自定义快捷菜单
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)  '关闭档案之前，触发的事件
    Call 删除快捷菜单   '在关闭档案之前，删除存在的自定义快捷菜单
End Sub


汇总
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)     '在单击右键之前，触发的事件
  If Target.Column = 1 Then  '列号为A时
    Application.CommandBars("我的菜单").ShowPopup '显示创建的"我的菜单"
    Cancel = True
  End If
End Sub

cp121ok

jiaxinl 发表于 2017-12-20 11:38
用的是右键的快捷菜单
代码如下：

当时没人回复，然后好久没看论坛，才发现。万分感谢，更重要的是还有各语句的解释。