Microsoft Office Tutorials and References
In Depth Information
Example 12-12. The CreateCustomMenu Procedure
the RunUtility procedure, we can use the ActionControl property to return the control that
caused the RunUtility procedure to execute. Then it is a simple matter to read the Tag and
Parameter properties of that control.
Example 12-12. The CreateCustomMenu Procedure
Sub CreateCustomMenu(sBarName As String)
Dim cbpop As CommandBarControl
Dim cbctl As CommandBarControl
Dim cbctlCurrentPopup As CommandBarControl
Dim iEnabledColumn As Integer
Dim iLastRow As Integer
Dim iCurrentRow As Integer
Dim sCurrentMenuItem As String
Dim sCurrentSubMenuItem As String
Dim sCurrentProcedure As String
Dim sCurrentWorkbook As String
Dim sCurrentOnAction As String
Dim ws As Worksheet
iEnabledColumn = OnWksMenu_Col ' Column for worksheet menu bar
If LCase(sBarName) = "chart menu bar" Then _
iEnabledColumn = OnChartMenu_Col
Set ws = ThisWorkbook.Worksheets("DataSheet")
' Create a popup control on main menu bar sBarName
Set cbpop = Application.CommandBars(sBarName). _
Controls.Add(Type:=msoControlPopup, Temporary:=True)
With cbpop
.Caption = "Cu&stom"
.Tag = "SRXUtilsCustomMenu"
End With
' Get last used row of DataSheet
iLastRow = Application.WorksheetFunction.CountA(ws.Range("A:A"))
' Go through DataSheet to get menu items
For iCurrentRow = 2 To iLastRow
' Set the values
sCurrentProcedure = ws.Cells(iCurrentRow, Procedure_Col).Value
sCurrentWorkbook = ws.Cells(iCurrentRow, InWorkbook_Col).Value
sCurrentMenuItem = ws.Cells(iCurrentRow, MenuItem_Col).Value
sCurrentSubMenuItem = ws.Cells(iCurrentRow,
SubMenuItem_Col).Value
sCurrentOnAction = ThisWorkbook.Name & "!" & _
ws.Cells(iCurrentRow, OnAction_Col).Value
' If no Submenu item then this is a button control
' else it is a popup control
If sCurrentSubMenuItem = "" Then
' Add button control
With cbpop.Controls.Add(Type:=msoControlButton,
Temporary:=True)
.Caption = sCurrentMenuItem
.OnAction = sCurrentOnAction
.Tag = sCurrentProcedure ' to pass this on
.Parameter = sCurrentWorkbook ' to pass this on
.Enabled = ws.Cells(iCurrentRow, iEnabledColumn).Value
 
Search JabSto ::




Custom Search