![]() Back to jkp-ads.com |
Ron de Bruin
|
|
Ron de Bruin decided to remove all Windows Excel content from his website for personal reasons. If you want to know why, head over to rondebruin.nl.
Luckily, Ron was kind enough to allow me to publish all of his Excel content here.
Most of these pages are slightly outdated and may contain links that don 't work. Please inform me if you find such an error and I'll try to fix it.
Kind regards
Jan Karel Pieterse
The most common Context Menu that most people know and use is the Cell
menu.
This is the menu that you see when you right click on a worksheet
cell or selection.
The screenshot below is from the Excel 2010 Cell
menu.
Note: On the bottom of the menu you also see the
name of the idMso of this
menu added by the Microsoft add-in discussed
later in this article.

The only way to change this menu up to Excel 2007 is to use VBA code, but
in Excel 2010 and up
you can also change a context menu with RibbonX. Visit
this page for RibbonX examples :
Customizing Context Menus in Microsoft Excel 2010-2016 with RibbonX
This example will add a custom button, built-in button (Save) and a
Custom menu on top of the Cell menu. Other context menus that you can change
are the Row and Column context menus for example.These are the menus that
you see when you right click on the row or column headers. See the Tips
section for a tip how to find the names of the other context menus.
Note: There are two Cell menu's in Excel, the second one
you see when you are in page break preview mode. If you want to change this
menu use this then in the code.
Set ContextMenu =
Application.CommandBars(Application.CommandBars("Cell").Index + 3)
The same applies to the Row and Column context menus.
Copy the six
macro's below into a General module of your workbook.
If you do not
know where to copy the code check out this page.
Where do I paste
the code that I find on the internet
The first macro adds the
controls to the Cell menu (see how I add a Tag to the controls I add).
The second macro deletes the controls from the Cell menu (See how I use the
Tag to delete the controls).
The other four macros will run when you
click on the Button or on one of the three options in the menu.
As a
example I use macro's that change the Case of the text cells in the
selection.
Sub AddToCellMenu()
Dim ContextMenu As CommandBar
Dim MySubMenu As CommandBarControl
'Delete the controls first to avoid duplicates
Call DeleteFromCellMenu
'Set ContextMenu to the Cell menu
Set ContextMenu = Application.CommandBars("Cell")
'Add one built-in button(Save = 3)to the cell menu
ContextMenu.Controls.Add Type:=msoControlButton, ID:=3, before:=1
'Add one custom button to the Cell menu
With ContextMenu.Controls.Add(Type:=msoControlButton, before:=2)
.OnAction = "'" & ThisWorkbook.Name & "'!" & "ToggleCaseMacro"
.FaceId = 59
.Caption = "Toggle Case Upper/Lower/Proper"
.Tag = "My_Cell_Control_Tag"
End With
'Add custom menu with three buttons
Set MySubMenu = ContextMenu.Controls.Add(Type:=msoControlPopup, before:=3)
With MySubMenu
.Caption = "Case Menu"
.Tag = "My_Cell_Control_Tag"
With .Controls.Add(Type:=msoControlButton)
.OnAction = "'" & ThisWorkbook.Name & "'!" & "UpperMacro"
.FaceId = 100
.Caption = "Upper Case"
End With
With .Controls.Add(Type:=msoControlButton)
.OnAction = "'" & ThisWorkbook.Name & "'!" & "LowerMacro"
.FaceId = 91
.Caption = "Lower Case"
End With
With .Controls.Add(Type:=msoControlButton)
.OnAction = "'" & ThisWorkbook.Name & "'!" & "ProperMacro"
.FaceId = 95
.Caption = "Proper Case"
End With
End With
'Add seperator to the Cell menu
ContextMenu.Controls(4).BeginGroup = True
End Sub
Sub DeleteFromCellMenu()
Dim ContextMenu As CommandBar
Dim ctrl As CommandBarControl
'Set ContextMenu to the Cell menu
Set ContextMenu = Application.CommandBars("Cell")
'Delete custom controls with the Tag : My_Cell_Control_Tag
For Each ctrl In ContextMenu.Controls
If ctrl.Tag = "My_Cell_Control_Tag" Then
ctrl.Delete
End If
Next ctrl
'Delete built-in Save button
On Error Resume Next
ContextMenu.FindControl(ID:=3).Delete
On Error GoTo 0
End Sub
Sub ToggleCaseMacro()
Dim CaseRange As Range
Dim CalcMode As Long
Dim cell As Range
On Error Resume Next
Set CaseRange = Intersect(Selection, _
Selection.Cells.SpecialCells(xlCellTypeConstants, xlTextValues))
On Error GoTo 0
If CaseRange Is Nothing Then Exit Sub
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
.EnableEvents = False
End With
For Each cell In CaseRange.Cells
Select Case cell.Value
Case UCase(cell.Value): cell.Value = LCase(cell.Value)
Case LCase(cell.Value): cell.Value = StrConv(cell.Value, vbProperCase)
Case Else: cell.Value = UCase(cell.Value)
End Select
Next cell
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = CalcMode
End With
End Sub
Sub UpperMacro()
Dim CaseRange As Range
Dim CalcMode As Long
Dim cell As Range
On Error Resume Next
Set CaseRange = Intersect(Selection, _
Selection.Cells.SpecialCells(xlCellTypeConstants, xlTextValues))
On Error GoTo 0
If CaseRange Is Nothing Then Exit Sub
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
.EnableEvents = False
End With
For Each cell In CaseRange.Cells
cell.Value = UCase(cell.Value)
Next cell
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = CalcMode
End With
End Sub
Sub LowerMacro()
Dim CaseRange As Range
Dim CalcMode As Long
Dim cell As Range
On Error Resume Next
Set CaseRange = Intersect(Selection, _
Selection.Cells.SpecialCells(xlCellTypeConstants, xlTextValues))
On Error GoTo 0
If CaseRange Is Nothing Then Exit Sub
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
.EnableEvents = False
End With
For Each cell In CaseRange.Cells
cell.Value = LCase(cell.Value)
Next cell
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = CalcMode
End With
End Sub
Sub ProperMacro()
Dim CaseRange As Range
Dim CalcMode As Long
Dim cell As Range
On Error Resume Next
Set CaseRange = Intersect(Selection, _
Selection.Cells.SpecialCells(xlCellTypeConstants, xlTextValues))
On Error GoTo 0
If CaseRange Is Nothing Then Exit Sub
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
.EnableEvents = False
End With
For Each cell In CaseRange.Cells
cell.Value = StrConv(cell.Value, vbProperCase)
Next cell
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = CalcMode
End With
End Sub
Copy the two event procedures below in the Thisworkbook module of your workbook This will automatically add the controls to the Cell menu when you open or activate the workbook and delete the controls when you close or deactivate the workbook
Private Sub Workbook_Activate()
Call AddToCellMenu
End Sub
Private Sub Workbook_Deactivate()
Call DeleteFromCellMenu
End Sub
Then save, close and reopen the workbook to see the changes in the Cell menu.
Change the Activate event to run different macros to create different menus
In the VBA example on this page I showed you how to change the Cell menu and I used the Activate and Deactivate event of the workbook to call a macro to create and delete the menu controls.
You can change the Activate event like this to create different menus for different users, this way you can create a menu with different sets of custom controls for different users. If you use the same Tags in the code there is no need to call a different macro to delete the menu.
Private Sub Workbook_Activate()
Dim sUserName As String
sUserName = Application.UserName
Select Case sUserName
Case "Ron de Bruin": Call AddToCellMenu
'Case "Dave Thomson": Call AddToCellMenu2
'Case Else: Call AddToCellMenu3
End Select
End Sub
In the example above you will see no changes in the menu if you are not
Ron de Bruin. See the two commented lines that show you how to call a
different macro if another user opens the workbook.
Another example
is to check for the Excel language in the activate event so you can create
menu captions in the language of the user in the context menu. In this case
if a Dutch or German user opens the workbook no menu will be created because
I commented out the two lines that call the macros you could make for these
two languages. For all other languages in this example the macro
AddToCellMenu is called and it creates a menu with English captions
Private Sub Workbook_Activate()
Dim LangID As Long
LangID = Application.International(xlCountryCode)
Select Case LangID
Case 31: 'Call AddToCellMenuInDutch
Case 49: 'Call AddToCellMenuinGerman
Case Else: Call AddToCellMenu
End Select
End Sub
For a list of country codes see
http://support.microsoft.com/kb/213833/en-us
How do I find the name of the contextmenu that I want to change ?
The example macro below will add button on the bottom of each contextmenu
with the menu name.
You will notice that you will not see a name on each
context menu when you run it in Excel 2007-2013.
For example, you will
not see it when you right click on a shape or Picture in Excel 2007-2010.
So it not seems to be possible to change these menus in Excel 2007-2010 with
VBA.
Sub Add_Name_To_Contextmenus()
Dim Cbar As CommandBar
For Each Cbar In Application.CommandBars
With Cbar
If .Type = msoBarTypePopup Then
On Error Resume Next
With .Controls.Add(Type:=msoControlButton)
.Caption = "Name for VBA = " & Cbar.Name
.Tag = "NameButtonInContextMenu"
End With
On Error GoTo 0
End If
End With
Next
End Sub
Sub Delete_Name_From_Contextmenus()
Dim Cbar As CommandBar
Dim ctrl As CommandBarControl
For Each Cbar In Application.CommandBars
With Cbar
If .Type = msoBarTypePopup Then
For Each ctrl In .Controls
If ctrl.Tag = "NameButtonInContextMenu" Then
ctrl.Delete
End If
Next ctrl
End If
End With
Next
End Sub
How do I find the control ID's or FaceID's :
Download Excel file with all
FaceID's from my site, you can use this file in Excel 97-2013
Find
the ID's and FaceId's see this page from Ole P. Erlandsen,
http://erlandsendata.no/?p=2694