Adding an item in Right Click Menu.


Option Explicit

Private Sub Workbook_Open()
    Call addButton
End Sub

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

Sub addButton()
Dim cBut
On Error Resume Next
    Application.CommandBars("Cell").Controls("RightClickMenu").Delete
On Error GoTo 0
    Set cBut = Application.CommandBars("Cell").Controls.Add(Temporary:=True)
    With cBut
        .Caption = "RighClickMenu"
        .Style = msoButtonCaption
        .OnAction = "MacroName"
    End With
End Sub


Someone asked for help for creating a submenu in the right click menu. For example, An item like ColorRange in the right click pop up menu, and if you go over it, then it gives option to color the cells.

Following is the code for that:

Write the following code in the workbooks open method to add the item automatically once you open the workbook.



Sub addButton()
Dim cBut As CommandBarPopup
Dim pic As PictureFormat

On Error Resume Next
Application.CommandBars("Cell").Controls("RightClickMenu").Delete
On Error GoTo 0
Set cBut = Application.CommandBars("Cell").Controls.Add(Type:=msoControlPopup, temporary:=True)

With cBut
.Caption = "Color Menu"
End With

Dim red As CommandBarButton
Dim blue As CommandBarButton
Dim green As CommandBarButton
Dim black As CommandBarButton

Set red = cBut.Controls.Add(temporary:=True)
Set blue = cBut.Controls.Add(temporary:=True)
Set green = cBut.Controls.Add(temporary:=True)
Set black = cBut.Controls.Add(temporary:=True)

red.Caption = "Red"
blue.Caption = "Blue"
green.Caption = "Green"
black.Caption = "Black"
red.Picture = stdole.LoadPicture("c:\red.bmp")
green.Picture = stdole.LoadPicture("c:\green.bmp")
black.Picture = stdole.LoadPicture("c:\black.bmp")
blue.Picture = stdole.LoadPicture("c:\blue.bmp")
red.OnAction = "RedColor"
blue.OnAction = "blueColor"
green.OnAction = "greenColor"
black.OnAction = "blackColor"
End Sub



Private Sub Workbook_Open()
Call addButton
End Sub




Once you are done with the above code, then create a new module and paste the following code in the newly created module.




Enum Color
red
blue
green
black
End Enum


Sub RedColor()
ColorCell (Color.red)
End Sub
Sub BlueColor()
ColorCell (Color.blue)
End Sub
Sub GreenColor()
ColorCell (Color.green)
End Sub
Sub BlackColor()
ColorCell (Color.black)
End Sub

Sub ColorCell(clr As Color)

Dim rng As Range
Dim sht As Worksheet
Dim typNme As String

typNme = TypeName(Application.Selection)

Select Case (typNme)
Case "Range"
Set rng = Application.Selection

Select Case (clr)
Case Color.red
rng.Interior.Color = ColorConstants.vbRed
Case Color.black
rng.Interior.Color = ColorConstants.vbBlack
Case Color.blue
rng.Interior.Color = ColorConstants.vbBlue
Case Color.green
rng.Interior.Color = ColorConstants.vbGreen
End Select
End Select



End Sub