S
s80NL
I've got the following code for a custom menu and it's working fine BU
how can I add FaceIds to the menu items? Is it also possible to sho
the custom shortcuts like they are showed in the default menu's (e.g
Ctrl+S for _S_ave in menu _F_ile?
PHP code
-------------------
'
' Macro found @ www.romanpress.com/Articles/Menus_R/Menus.htm
' Made some minor adjustments only
'
Private Sub AddMenu()
Dim cbpop As CommandBarControl
Dim cbctl As CommandBarControl
Dim cbsub As CommandBarControl
Dim cbpos As Integer
On Error Resume Next
Application.CommandBars("Worksheet Menu Bar").Controls("Custom Menu").Delete
On Error GoTo 0
' Create a popup control on the main menu bar
cbpos = Application.CommandBars("Worksheet Menu Bar").Controls("Help").Index
Set cbpop = Application.CommandBars("Worksheet Menu Bar"). _
Controls.Add(Type:=msoControlPopup, Before:=cbpos)
cbpop.Caption = mname
cbpop.Visible = True
' Add menu item
Set cbctl = cbpop.Controls.Add(Type:=msoControlButton)
cbctl.Visible = True
cbctl.Style = msoButtonCaption
cbctl.Caption = "&Update rapport"
cbctl.OnAction = "UpdateRapport"
' Add menu item
Set cbctl = cbpop.Controls.Add(Type:=msoControlButton)
cbctl.Visible = True
cbctl.Style = msoButtonCaption
cbctl.Caption = "&Print all sheets"
cbctl.OnAction = "PrintAllSheets"
' Add a popup for a submenu
Set cbsub = cbpop.Controls.Add(Type:=msoControlPopup)
cbsub.Visible = True
cbsub.Caption = "Rapport op&slaan als..."
' Add submenu item
Set cbctl = cbsub.Controls.Add(Type:=msoControlButton)
cbctl.Visible = True
cbctl.Style = msoButtonCaption
cbctl.Caption = "Save As (Preformatted)"
cbctl.OnAction = "SaveAs"
' Add submenu item
Set cbctl = cbsub.Controls.Add(Type:=msoControlButton)
cbctl.Visible = True
cbctl.Style = msoButtonCaption
cbctl.Caption = "Save Copy As (Preformatted)"
cbctl.OnAction = "SaveCopyAs"
End Su
-------------------
how can I add FaceIds to the menu items? Is it also possible to sho
the custom shortcuts like they are showed in the default menu's (e.g
Ctrl+S for _S_ave in menu _F_ile?
PHP code
-------------------
'
' Macro found @ www.romanpress.com/Articles/Menus_R/Menus.htm
' Made some minor adjustments only
'
Private Sub AddMenu()
Dim cbpop As CommandBarControl
Dim cbctl As CommandBarControl
Dim cbsub As CommandBarControl
Dim cbpos As Integer
On Error Resume Next
Application.CommandBars("Worksheet Menu Bar").Controls("Custom Menu").Delete
On Error GoTo 0
' Create a popup control on the main menu bar
cbpos = Application.CommandBars("Worksheet Menu Bar").Controls("Help").Index
Set cbpop = Application.CommandBars("Worksheet Menu Bar"). _
Controls.Add(Type:=msoControlPopup, Before:=cbpos)
cbpop.Caption = mname
cbpop.Visible = True
' Add menu item
Set cbctl = cbpop.Controls.Add(Type:=msoControlButton)
cbctl.Visible = True
cbctl.Style = msoButtonCaption
cbctl.Caption = "&Update rapport"
cbctl.OnAction = "UpdateRapport"
' Add menu item
Set cbctl = cbpop.Controls.Add(Type:=msoControlButton)
cbctl.Visible = True
cbctl.Style = msoButtonCaption
cbctl.Caption = "&Print all sheets"
cbctl.OnAction = "PrintAllSheets"
' Add a popup for a submenu
Set cbsub = cbpop.Controls.Add(Type:=msoControlPopup)
cbsub.Visible = True
cbsub.Caption = "Rapport op&slaan als..."
' Add submenu item
Set cbctl = cbsub.Controls.Add(Type:=msoControlButton)
cbctl.Visible = True
cbctl.Style = msoButtonCaption
cbctl.Caption = "Save As (Preformatted)"
cbctl.OnAction = "SaveAs"
' Add submenu item
Set cbctl = cbsub.Controls.Add(Type:=msoControlButton)
cbctl.Visible = True
cbctl.Style = msoButtonCaption
cbctl.Caption = "Save Copy As (Preformatted)"
cbctl.OnAction = "SaveCopyAs"
End Su
-------------------