求助一个添加单元格右键菜单的问题，

COSByVal

从网上找了一段添加单元格右键菜单的代码，运行后只有第一个子菜单能够执行，第二个、第三个都提示无法运行相关的宏，拜托各位老师该看一下，谢谢！

COSByVal

求大神帮忙，谢谢！

COSByVal

求大神帮忙，谢谢！

COSByVal

求大神帮忙，谢谢！

lujkhua

将OnAction的值直接写过程名：

1. Option Explicit
   
2. '定义添加单元格菜单函数
   
3. Public Sub addcellMenu()
   
4.     Dim custMenu As CommandBar
   
5.     Dim subMenu As CommandBarControl '定义PopupMenu
   
6.     deletecellMenu '调用deletecellMenu函数
   
7.     Set custMenu = Application.CommandBars("cell")
   
8.     Set subMenu = custMenu.Controls.Add(msoControlPopup, , , 1) '创建Popup按钮
   
9.     With subMenu '对Popup按钮设置Caption(文字描述)
   
10.         .Caption = "Tools"
    
11.         With .Controls.Add(msoControlButton) 'Popup按钮添加子按钮
    
12.             .Caption = "第一个子菜单"
    
13.             .OnAction = "insertyfm" '指定时间对应的宏（函数）Clean_up
    
14.             .FaceId = 164 '设置图标
    
15.         End With
    
16.         With .Controls.Add(msoControlButton)
    
17.             .Caption = "第二个子菜单"
    
18.             .OnAction = "adddate"
    
19.             .FaceId = 165
    
20.         End With
    
21.         With .Controls.Add(msoControlButton)
    
22.             .Caption = "第三个子菜单"
    
23.             .OnAction = "thredsubmenu"
    
24.             .FaceId = 166
    
25.         End With
    
26.     End With
    
27.     Set subMenu = Nothing '将创建的对象subMenu设置为Nothing
    
28.     Set custMenu = Nothing
    
29. End Sub
    
30. '将选中单元格内容转化为百分比
    
31. Public Sub adddate()
    
32.     Dim item As Variant
    
33.     For Each item In Selection
    
34.         item.Value = "第二个子菜单"
    
35.     Next
    
36. End Sub
    
37. '定义Clean_up函数清空选中区域的格式和内容
    
38. Public Sub insertyfm()
    
39.     Dim item As Variant
    
40.     For Each item In Selection
    
41.         item.Value = "第一个子菜单"
    
42.     Next
    
43. End Sub
    
44. Public Sub thredsubmenu()
    
45.     Dim item As Variant
    
46.     For Each item In Selection
    
47.         item.Value = "第三个子菜单"
    
48.     Next
    
49. End Sub
    
50. '定义清除单元格控件Tools函数，保证如果之前如果已经添加Tools按钮
    
51. '那么会先清除之前的Tool按钮
    
52. Public Sub deletecellMenu()
    
53.     On Error Resume Next
    
54.     Application.CommandBars("cell").Controls("Tools").Delete
    
55.     On Error GoTo 0
    
56. End Sub

复制代码

leimingsen