vba 向右键菜单添加宏

Add a macro to the right-button menu

提问by Gabriel Quesada

I would like to add a created macro to the right-button menu. Is it possible?

我想在右键菜单中添加一个创建的宏。是否可以？

Thanks a lot!

非常感谢！

回答by brettdj

If you meant add a macro to the options when you right click you mouse then you could try this code CreateMacrowhich assigns Test_Macroto the right click menu with a caption YourCode.

如果您打算在右键单击鼠标时向选项添加宏，那么您可以尝试使用此代码CreateMacro，它将Test_Macro分配给带有标题YourCode的右键单击菜单。

Run KillMacroto remove the menu item

运行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

回答by JMax

Here is a great piece of code:

这是一段很棒的代码：

code for the ThisWorkbookcode sheet

对于代码的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

code for a new module

新模块的代码

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

Found on VBAExpress

在VBAExpress上找到