在右键菜单中添加一个宏

时间:2011-09-14 09:01:14

标签: excel excel-vba vba

我想在右键菜单中添加一个创建的宏。有可能吗?

非常感谢!

2 个答案:

答案 0 :(得分:6)

如果您想在右键单击鼠标时向选项添加宏,则可以尝试使用 TestMacro TestMacro 分配给带有标题的右键菜单 TestMacro YourCode

运行KillMacro以删除菜单项

Const strMacro = "YourCode"

Sub CreateMacro()
   Dim cBut
   Call KillMacro
   Set cBut = Application.CommandBars("Cell").Controls.Add(Temporary:=True)
   With cBut
       .Caption = strMacro
       .Style = msoButtonCaption
       .OnAction = "Test_Macro"
   End With
End Sub

Sub Test_Macro()
   MsgBox "I work"
End Sub

Sub KillMacro()
   On Error Resume Next
   Application.CommandBars("Cell").Controls(strMacro).Delete
End Sub

答案 1 :(得分:1)

这是一段很棒的代码:

ThisWorkbook 代码表的

代码
Option Explicit 

Private Sub Workbook_BeforeClose(Cancel As Boolean) 

     'remove our custom menu before we leave
    Run ("DeleteCustomMenu") 

End Sub 

Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean) 

    Run ("DeleteCustomMenu") 'remove possible duplicates
    Run ("BuildCustomMenu") 'build new menu

End Sub 
 '### code for the ThisWorkbook code sheet - END
新模块的

代码

Option Explicit 

Private Sub BuildCustomMenu() 

    Dim ctrl As CommandBarControl 
    Dim btn As CommandBarControl 
    Dim i As Integer 

     'add a 'popup' control to the cell commandbar (menu)
    Set ctrl = Application.CommandBars("Cell").Controls.Add _ 
    (Type:=msoControlPopup, Before:=1) 
    ctrl.Caption = "Insert Shape..." 
     'add the submenus
    For i = 50 To 250 Step 50 'add a few menu items
        Set btn = ctrl.Controls.Add 
        btn.Caption = i & " x " & (i / 2) 'give them a name
        btn.Tag = i 'we'll use the tag property to hold a value
        btn.OnAction = "InsertShape" 'the routine called by the control
    Next 

End Sub 

Private Sub DeleteCustomMenu() 

    Dim ctrl As CommandBarControl 

     'go thru all the cell commandbar controls and delete our menu item
    For Each ctrl In Application.CommandBars("Cell").Controls 
        If ctrl.Caption = "Insert Shape..." Then ctrl.Delete 
    Next 

End Sub 

Private Sub InsertShape() 

    Dim t As Long 
    Dim shp As Shape 

     'get the tag property of the clicked control
    t = CLng(Application.CommandBars.ActionControl.Tag) 

     'use the value of t and the active cell as size and position parameters
     'for adding a rectangle to the worksheet
    Set shp = ActiveSheet.Shapes.AddShape _ 
    (msoShapeRectangle, ActiveCell.Left, ActiveCell.Top, t, t / 2) 
     'do something with our shape
    Randomize 'make it a random color from the workbook
    shp.Fill.ForeColor.SchemeColor = Int((56 - 1 + 1) * Rnd + 1) 

End Sub 
 '### code for a new module - END

VBAExpress

上找到