View Single Post
  #7   Report Post  
Posted to microsoft.public.excel.programming
Scott KBC[_2_] Scott KBC[_2_] is offline
external usenet poster
 
Posts: 3
Default 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