'### 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