CODEWITHSUNDEEP
excelvba
Gabriel Quesada
Gabriel Quesada

Reputation: 163

Add a macro to the right-button menu

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

Thanks a lot!

Upvotes: 3

Views: 11223

Answers (2)

brettdj
brettdj

Reputation: 55702

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

Run KillMacro to remove the menu item

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

Upvotes: 6

JMax
JMax

Reputation: 26611

Here is a great piece of code:

code for the ThisWorkbook code sheet

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

Upvotes: 2

Related Questions