Add custom button to the right click menu after right clicking on a range

[MarieBocc]

Hello everyone,

So I have a macro called Duplication I wrote and I want to add it from the right click menu with the caption Dupliquer.
I have found this code which allows it when I right click on a cell :

[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]Private Sub Workbook_Deactivate()
    On Error Resume Next
        With Application
            .CommandBars("Cell").Controls("Duplication").Delete
        End With
    On Error GoTo 0
End Sub
 
Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)[/FONT]
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]    Dim cmdBtn As CommandBarButton
    On Error Resume Next
        With Application
            .CommandBars("Cell").Controls("Duplication").Delete
            Set cmdBtn = .CommandBars("Cell").Controls.Add(Temporary:=True)
        End With
 
        With cmdBtn
           .Caption = "Dupliquer"
           .Style = msoButtonCaption
           .OnAction = "Duplication"
        End With
    On Error GoTo 0
End Sub
[/FONT]

So this code indeed adds a Dupliquer option in the menu when I right click. It works so well it even adds it every time I right click though ! Meaning after 3 right clicks I have the new option thrice in my menu, which wasn't excactly what I was hoping for...

But my biggest problem is that this only works for a right click on a single cell and my macro is supposed to work on a range of cells. I naively tried turning every "Cell" into "Range" (I am new to VBA) but of course it did not work.

Any idea ?
Any tip would be greatly appreciated !

Thank you for reading,

Marie

 

[mole999]

if you chage >
Workbook_SheetBeforeRightClick to the worksheet activate routine, then it should only add once

 

[Jaafar Tribak]

You could reset the context menu each time before adding the new entry:

Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)    Dim cmdBtn As CommandBarButton
    On Error Resume Next
        With Application
             [COLOR=#ff0000][B].CommandBars("Cell").Reset[/B][/COLOR]
[COLOR=#008000]'            .CommandBars("Cell").Controls("Duplication").Delete[/COLOR]
            Set cmdBtn = .CommandBars("Cell").Controls.Add(Temporary:=True)
        End With
 
        With cmdBtn
           .Caption = "Dupliquer"
           .Style = msoButtonCaption
           .OnAction = "Duplication"
        End With
    On Error GoTo 0
End Sub

But my biggest problem is that this only works for a right click on a single cell and my macro is supposed to work on a range of cells. I naively tried turning every "Cell" into "Range" (I am new to VBA) but of course it did not work.

Strange! That shouldn't happen... It should work regardless of how many cells are selected .

Do you have any other code that may be interfering ?

 

[Jaafar Tribak]

Or maybe better than resetting the commandbar which may also delete other custom entries, I would use this :

Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
    Dim cmdBtn As CommandBarButton
    On Error Resume Next
        With Application
           [COLOR=#0000ff][B] .CommandBars("Cell").Controls(.CommandBars("Cell").Controls.Count).Delete[/B][/COLOR]
            Set cmdBtn = .CommandBars("Cell").Controls.Add(Temporary:=True)
        End With
 
        With cmdBtn
           .Caption = "Dupliquer"
           .Style = msoButtonCaption
           .OnAction = "Duplication"
        End With
    On Error GoTo 0
End Sub

 

[MarieBocc]

First of all thank you so much for your answers and your reactivity !
This was of a great help ! I no longer have the caption associated to my macro several times in my menu.

Strange! That shouldn't happen... It should work regardless of how many cells are selected .

Do you have any other code that may be interfering ?

I don't think so. But I think I found something which makes my previous statment untrue : I can actually get it in the right click menu with a range !
The thing is, I use the very first column (the one that indicate the row number) to select a range containing all the datas in the entire row instead of directly selecting the first and last cell of the range for there are more than 800 columns. And it's precisely when I select my range like this that it doesn't work.

Do you have a solution for this ? Or is there maybe another way to select a range of entire rows ?

 

[Jaafar Tribak]

Tha's another context menu called Row same with Column if you select an entire column.

Try this :

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

    Dim cmdBtn As CommandBarButton
    Dim sContextMenu As String
    
    Select Case True
        Case Target.Rows.Count = Rows.Count
            sContextMenu = "Row"
        Case Target.Columns.Count = Columns.Count
            sContextMenu = "Column"
        Case Else
            sContextMenu = "Cell"
    End Select
   
    On Error Resume Next
        With Application
            .CommandBars(sContextMenu).Controls(.CommandBars(sContextMenu).Controls.Count).Delete
            Set cmdBtn = .CommandBars(sContextMenu).Controls.Add(Temporary:=True)
        End With
 
        With cmdBtn
           .Caption = "Dupliquer"
           .Style = msoButtonCaption
           .OnAction = "Duplication"
        End With
    On Error GoTo 0
    
End Sub

 

[MarieBocc]

It works exactly like I imagined it !

Thanks a lot Mr. Jaafar, it was on point ! ray:

 

[Jaafar Tribak]

BTW,

Do you have the OnAction Macro located in different standard module ?

If so, then let me tell that you could keep the onaction macro inside the ThisWorkbook module together with the BeforRightClick event sub... I like keeping the codes together.

Try this :

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

    Dim cmdBtn As CommandBarButton
    Dim sContextMenu As String
    
    Select Case True
        Case Target.Rows.Count = Rows.Count
            sContextMenu = "Row"
        Case Target.Columns.Count = Columns.Count
            sContextMenu = "Column"
        Case Else
            sContextMenu = "Cell"
    End Select
   
    On Error Resume Next
        With Application
            .CommandBars(sContextMenu).Controls(.CommandBars(sContextMenu).Controls.Count).Delete
            Set cmdBtn = .CommandBars(sContextMenu).Controls.Add(Temporary:=True)
        End With
 
        With cmdBtn
           .Caption = "Dupliquer"
           .Style = msoButtonCaption
           [B][COLOR=#0000ff].OnAction = Me.CodeName & ".Duplication"[/COLOR][/B]
        End With
    On Error GoTo 0
    
End Sub


[B][COLOR=#0000ff]Private Sub Duplication()[/COLOR][/B]

   [B][COLOR=#008000] 'Code goes here..[/COLOR][/B]

[COLOR=#0000ff][B]End Sub[/B][/COLOR]

 

[MarieBocc]

I guess this is a coding good-practice advice ! I'll keep that in mind when coding even though I still need to improve my skills at adapting tips to my own code !

By the way, to add a separator inbetween Dupliquer and the rest of the menu, do I have to create another type of object or can I easily add it from the code I have right now ?

 

[Jaafar Tribak]

By the way, to add a separator inbetween Dupliquer and the rest of the menu, do I have to create another type of object or can I easily add it from the code I have right now ?

Just set the BeginGroup Property to True.

You can also change the control Style Property to msoButtonIconAndCaption to add an icon :

        With cmdBtn
           [COLOR=#0000ff][B].BeginGroup = True[/B][/COLOR]
           .Caption = "Dupliquer"
           [B][COLOR=#0000ff].Style = msoButtonIconAndCaption[/COLOR][/B]
           [B][COLOR=#0000ff].FaceId = 590[/COLOR][/B]
           .OnAction = Me.CodeName & ".Duplication"
        End With

Experiment with the faceid until you are happy with it https://bettersolutions.com/vba/ribbon/face-ids-2003.htm