Adding option on right click

tyampoo

New Member
Joined
Mar 17, 2008
Messages
5
hi,

i am very new to excel programming and i want to add a option on right click. how do i start?

Tyampoo
 

Excel Facts

Convert text numbers to real numbers
Select a column containing text numbers. Press Alt+D E F to quickly convert text to numbers. Faster than "Convert to Number"
Try this. Paste the following into the Sheet1 code:

Code:
Option Explicit

Public Sub AddRightClickMenuOption()

    Const sMenuText As String = "My Menu Option"
    Const sMacroToRun As String = "My_Macro"
    
    'Ignore error which occurs if menu item to be deleted does not exist
    On Error Resume Next
    
    'Delete menu item
    CommandBars("Cell").Controls(sMenuText).Delete
    
    'Reinstate default error handling
    On Error GoTo 0
    
    'Alternative method to delete menu item - no error handling required
    Dim i As Integer
    Dim cbarCtrl As CommandBarControl
    For i = 1 To CommandBars("Cell").Controls.Count
        Set cbarCtrl = CommandBars("Cell").Controls(i)
        If cbarCtrl.Caption = sMenuText Then cbarCtrl.Delete
    Next
    
    'Add new menu item
    With CommandBars("Cell").Controls.Add(msoControlButton, , , 1, True)
        .Caption = sMenuText
        .OnAction = sMacroToRun
        .BeginGroup = True
    End With
    
End Sub
Paste the following into a module (e.g. Module1):
Code:
Option Explicit

Public Sub My_Macro()

    MsgBox "This is My_Macro"
    
End Sub
 
Upvote 0
That worked! Thank you.

I also tried making sub-menu. I have a dynamic range(i used OFFSET) in sheet2. I need to make sub-menu from content of that range.
I am still searching to read from range of another sheet but no luck till now.

i appreciate ur help.
Tyampoo
 
Upvote 0
I found something!
I needed to add an option on right click and under that i had to add submenu from a 'used' cell in sheet2 which could grow and sink.
I used following:
Sheet2 //ref: http://www.mindspring.com/~tflynn/excelvba.html
Code:
' This sub calls sub in sheet1 so that dynamic range is adjusted
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Application.EnableEvents = False
    Call Sheet1.AddRightClickMenuOption
Application.EnableEvents = True
End Sub

sheet2 //ref: reply from John_w and http://www.ozgrid.com/forum/showthread.php?t=84594
Code:
Public Sub AddRightClickMenuOption()
    Const sMenuText As String = "Projects"
    Const sMacroToRun As String = "My_Macro"
 
    'Ignore error which occurs if menu item to be deleted does not exist
    On Error Resume Next
 
    'Delete menu item
    CommandBars("Cell").Controls(sMenuText).Delete
 
    'Reinstate default error handling
    On Error GoTo 0
 
    'Add new menu item
    Dim cLoop As Range
    CommandBars("Cell").Controls.Add(msoControlPopup).Caption = sMenuText
    With CommandBars("Cell").Controls(sMenuText)
        'Add sub menu
        For Each cLoop In Sheet2.Range("Projects").Cells
            .Controls.Add(Type:=msoControlButton).Caption = cLoop.Cells.Value
        Next
     End With
 
End Sub

now i am looking for onAction where each sub-menu do its work!

I appreciate ur help
Tyampoo
 
Last edited:
Upvote 0
This adds a right-click cell menu item and sub menu items from the 'Projects' named range. Paste everything into a Module - it replaces all my previously posted code.

Code:
Option Explicit

Public Sub Reset_Cell_Menu()
    Application.CommandBars("Cell").Reset
End Sub


Public Sub AddRightClickMenuOption2()

    'Add a menu option and sub menu options to Excel's right-click cell menu

    Const sMainMenuText As String = "Projects"
    
    Dim sMacroToRun As String
    Dim cbcMainMenu As CommandBarControl
    Dim cbcSubMenu As CommandBarControl
    Dim rCell As Range
    Dim sAction As String
    Dim sCellReference As String
       
    'Ignore error which occurs if menu item about to be deleted does not exist
    
    On Error Resume Next
    
    'Delete existing menu item (if previously added)
    
    CommandBars("Cell").Controls(sMainMenuText).Delete
    
    'Reinstate default error handling
    
    On Error GoTo 0
           
    'Add new menu item as first item
    
    Set cbcMainMenu = CommandBars("Cell").Controls.Add(msoControlPopup, Before:=1)
    
    With cbcMainMenu
        .Caption = sMainMenuText
        
        'Add sub menu items from the Projects named range
        
        For Each rCell In Range("Projects").Cells
        
            Set cbcSubMenu = .Controls.Add(msoControlButton)
            
            With cbcSubMenu
                .Caption = rCell.Value
                               
                'My_Macro()
                'sMacroToRun = "My_Macro"
                'sAction = "'" & sMacroToRun & "'"
                         
                'My_Macro_With_Params(sProjectName As String)
                'sMacroToRun = "My_Macro_With_Params"
                'sAction = "'" & sMacroToRun & " " & _
                '            """" & rCell.Value & """" & _
                '            "'"
                
                'My_Macro_With_Params2(sProjectName As String, sCellReference As String)
                'sMacroToRun = "My_Macro_With_Params2"
                'sCellReference = rCell.Worksheet.Name & "!" & rCell.Address
                'sAction = "'" & sMacroToRun & " " & _
                '            """" & rCell.Value & """" & ", " & _
                '            """" & sCellReference & """" & _
                '            "'"
                
                'My_Macro_With_Params3(sProjectName As String, sSheet as String, iRow As Integer, iCol As Integer)
                sMacroToRun = "My_Macro_With_Params3"
                sAction = "'" & sMacroToRun & " " & _
                            """" & rCell.Value & """" & ", " & _
                            """" & rCell.Worksheet.Name & """" & ", " & _
                            rCell.Row & ", " & _
                            rCell.Column & _
                            "'"
                
                MsgBox "OnAction = " & sAction
                .OnAction = sAction
                
            End With
        Next

    End With
    
End Sub


Public Sub My_Macro()

    MsgBox "This is My_Macro"
    
End Sub


Public Sub My_Macro_With_Params(sProjectName As String)

    MsgBox "This is My_Macro_With_Params" & vbNewLine & _
        "Project name = " & sProjectName
    
End Sub


Public Sub My_Macro_With_Params2(sProjectName As String, sCellReference As String)

    MsgBox "This is My_Macro_With_Params2" & vbNewLine & _
        "Project name = " & sProjectName & vbNewLine & _
        "Cell reference = " & sCellReference
    
End Sub


Public Sub My_Macro_With_Params3(sProjectName As String, sSheet As String, iRow As Integer, iCol As Integer)
    
    MsgBox "This is My_Macro_With_Params3" & vbNewLine & _
        "Project name = " & sProjectName & vbNewLine & _
        "Sheet = " & sSheet & vbNewLine & _
        "Row = " & iRow & vbNewLine & _
        "Column = " & iCol
            
End Sub
You will probably want the OnAction subroutine to accept parameters which depend on which sub menu item is clicked, so I've included 3 examples of this, showing how to pass different parameters.

Also notice Reset_Cell_Menu() which can be run to re-establish Excel's default menu - it's very easy to mess things up while experimenting with these menus.
 
Upvote 0
was almost done!

what i was able to do:
.on right click there would appear "Projects"
.under "Projects" there is project names
.when u select project, it would
. it calls function with selected project name as parameter
. put project name under selected cells
. do some manipulation in summary sheet

(summary sheet contains name of projects under named range "Projects")

checked here and there and fond code snipped but
this did not work??
Code:
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    Application.EnableEvents = False
    Call Sheet1.AddRightClickMenuOption
    Application.EnableEvents = True
End Sub

my confusion, it worked in my test file but when i tried in actual file (this is in the portal) it did not and to my dismay it doesn't work in my test file now!
any idea why?

i need to dynamically add projects as and when added to the list.
i think i have mentioned earlier that i used OFFSET for dynamic range
=OFFSET(Sheet2!$A$1,0,0, COUNTA(Sheet2!$A$1:$A$1000),1)

I appreciate ur help,
Tyampoo.
 
Upvote 0
Thank you all who looked in and specially to John_w who helped me out.

For some weired reason it did not work and for same reason it is working now. I don't know why?

I appreciate ur help,
Tyampoo
 
Upvote 0

Forum statistics

Threads
1,213,557
Messages
6,114,287
Members
448,562
Latest member
Flashbond

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top