Creating Option Entries in Excel Menu Bars using VB
That's fabulous, thanks very much Gareth. I'll have a good look at your code
and get it all working from there I'm sure. Your help and time have been
greatly appreciated.
"Gareth" wrote:
Hi Scott,
Stick with it. It's just because you're not familiar with it. I find CBs
far easier - because I'm used to them... And you can do as many submenus
as you need.
Below I've pasted code that demonstrates a submenu and a submenu of a
submenu as well as a working toggling, checkmark. And - would you
believe - I've even tested it... just in case it was my error that
introduced your with/end with problem
HTH,
Gareth
-----------------------
Option Explicit
Sub CommandBarLoad()
Dim NewItem As CommandBarControl
Dim NewSubItem As CommandBarControl
Dim NewSubSubItem As CommandBarControl
Const TOOLBAR_NAME As String = "ScottBar"
'Create our commandbar
On Error GoTo Errorhandler_ToolbarExists
Application.CommandBars.Add(Name:=TOOLBAR_NAME, Position:=msoBarTop,
Temporary:=True).Visible = True
On Error GoTo 0
With Application.CommandBars(TOOLBAR_NAME)
'Here we just add a button with an icon
Set NewItem = .Controls.Add(Type:=msoControlButton)
With NewItem
.Caption = "&Open Something"
.OnAction = "OpenSomething"
.Style = msoButtonIcon
.BeginGroup = True
.FaceId = 620
End With
'This is a button with a text label
Set NewItem = .Controls.Add(Type:=msoControlButton)
With NewItem
.Caption = "&Close Something"
.OnAction = "CloseSomething"
.Style = msoButtonCaption
.BeginGroup = True
.TooltipText = "Write something here if you like"
End With
'Now let's have a button with sub buttons thus:
'MY TOOLS - Do Good
' Do Better
' Do Best
' - COLOUR - Make Red
' - Make Blue
' - Make Green
' - Toggle Flag
'
Set NewItem = .Controls.Add(Type:=msoControlPopup)
With NewItem
.Caption = "My T&ools"
.BeginGroup = True
Set NewSubItem = .Controls.Add(Type:=msoControlButton)
With NewSubItem
.Caption = "Do &Good"
.OnAction = "DoGood"
.Style = msoButtonCaption
End With
Set NewSubItem = .Controls.Add(Type:=msoControlButton)
With NewSubItem
.Caption = "Do &Better"
.OnAction = "DoBetter"
.Style = msoButtonCaption
End With
Set NewSubItem = .Controls.Add(Type:=msoControlButton)
With NewSubItem
.Caption = "Do B&est"
.OnAction = "DoBest"
.Style = msoButtonCaption
End With
Set NewSubItem = .Controls.Add(Type:=msoControlPopup)
With NewSubItem
.Caption = "&Colour"
Set NewSubSubItem = .Controls.Add(Type:=msoControlButton)
With NewSubSubItem
.Caption = "Make &Red"
.OnAction = "MakeRed"
.Style = msoButtonCaption
End With
Set NewSubSubItem = .Controls.Add(Type:=msoControlButton)
With NewSubSubItem
.Caption = "Make &Blue"
.OnAction = "MakeBlue"
.Style = msoButtonCaption
End With
Set NewSubSubItem = .Controls.Add(Type:=msoControlButton)
With NewSubSubItem
.Caption = "Make &Green"
.OnAction = "MakeGreen"
.Style = msoButtonCaption
End With
End With
Set NewSubItem = .Controls.Add(Type:=msoControlButton)
With NewSubItem
.Caption = "&Toggle Flag"
.OnAction = "fcnToggleFlag"
.Style = msoButtonCaption
End With
End With
End With
'tidy up
Set NewItem = Nothing
Set NewSubItem = Nothing
Set NewSubSubItem = Nothing
'Skip ErrorHandling Section
Exit Sub
Errorhandler_ToolbarExists:
'Let's delete it and rebuild....
Application.CommandBars(TOOLBAR_NAME).Delete
Resume
End Sub
Function fcnToggleFlag() As Boolean
Const TOOLBAR_NAME As String = "ScottBar"
On Error GoTo ErrorHandler
With Application.CommandBars(TOOLBAR_NAME).Controls("My
Tools").Controls("Toggle Flag")
.State = Not .State
End With
Exit Function
ErrorHandler:
CommandBarLoad
Resume
End Function
|