Example The Create CustomMenu 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,


.Caption = sCurrentMenuItem .OnAction = sCurrentOnAction .Tag = sCurrentProcedure .Parameter = sCurrentWorkbook .Enabled = ws.Cells(iCurrentRow to pass this on to pass this on iEnabledColumn).Value

End With Else

' Add popup control if it is not already added If sCurrentMenultem <> "" Then

Set cbctlCurrentPopup = cbpop.Controls.Add(

Type:=msoControlPopup, Temporary:=True) cbctlCurrentPopup.Caption = sCurrentMenultem End If

' Now add the submenu item, which is a button control With cbctlCurrentPopup.Controls.Add(

Type:=msoControlButton, Temporary:=True) .Caption = sCurrentSubMenultem .OnAction = sCurrentOnAction

.Tag = sCurrentProcedure ' to pass this on

.Parameter = sCurrentWorkbook ' to pass this on .Enabled = ws.Cells(iCurrentRow, iEnabledColumn).Value End With End If Next ' row End Sub

0 0

Post a comment