Hi
I wrote this a while ago to demonstrate the various commandbar options
available:
In the Workbook Code Module
Private Sub Workbook_Activate()
Toolbar_ON
End Sub
Private Sub Workbook_Deactivate()
Toolbar_OFF
End Sub
In a regular Code Module
Const cCommandBar = "MyCommandBar"
Sub Toolbar_OFF()
Dim bar As CommandBar
''' Delete the Commandbar if it already exists
For Each bar In Application.CommandBars
If bar.Name = cCommandBar Then bar.Delete
Next
End Sub
Sub Toolbar_ON()
Dim bar As CommandBar
Toolbar_OFF
Set bar = Application.CommandBars.Add(Name:=cCommandBar, _
Position:=msoBarTop, Temporary:=True)
''' Button 1
With bar.Controls.Add(Type:=msoControlButton)
.FaceId = 136
.Caption = "Drink Me"
.TooltipText = "Click here for a Message Box"
.Style = msoButtonIconAndCaption
.OnAction = ThisWorkbook.Name & "!Button_Click"
.Parameter = "Button 1"
End With
''' Button 2
With bar.Controls.Add(Type:=msoControlButton)
.FaceId = 136
.Caption = "Eat Me"
.TooltipText = "Click here for a Message Box"
.Style = msoButtonIconAndCaption
.OnAction = ThisWorkbook.Name & "!Button_Click"
.Parameter = "Button 2"
End With
''' Toggle
With bar.Controls.Add(Type:=msoControlButton)
.FaceId = 134
.Caption = "Toggle Me"
.Style = msoButtonIconAndCaption
.State = msoButtonUp
.OnAction = ThisWorkbook.Name & "!Toggle_Click"
.Parameter = "Toggle 1"
End With
''' Edit
With bar.Controls.Add(Type:=msoControlEdit)
.OnAction = ThisWorkbook.Name & "!Edit_Enter"
.Parameter = "Edit 1"
End With
''' Dropdown
With bar.Controls.Add(Type:=msoControlDropdown)
.AddItem "Newton"
.AddItem "Galileo"
.AddItem "Einstein"
.DropDownLines = 15
.DropDownWidth = 100
'.ListHeaderCount = 1
.ListIndex = 3
.OnAction = ThisWorkbook.Name & "!Dropdown_Click"
.Parameter = "Dropdown 1"
End With
''' Combo
With bar.Controls.Add(Type:=msoControlComboBox)
.AddItem "Processor"
.AddItem "Hard Drive"
.AddItem "Memory"
.AddItem "Graphics"
.DropDownLines = 15
.DropDownWidth = 100
'.ListHeaderCount = 1
.ListIndex = 2
.OnAction = ThisWorkbook.Name & "!ComboBox_Click"
.Parameter = "Combo 1"
End With
''' Popup
With bar.Controls.Add(Type:=msoControlPopup)
.Caption = "Cards"
.BeginGroup = True
With .Controls.Add(Type:=msoControlPopup)
.Caption = "Red Cards"
With .CommandBar.Controls.Add(Type:=msoControlButton)
.FaceId = 481
.Caption = "Heart"
.OnAction = ThisWorkbook.Name & "!Popup_Click"
.Parameter = "Cards/Red Cards/Heart"
End With
With .CommandBar.Controls.Add(Type:=msoControlButton)
.FaceId = 482
.Caption = "Diamond"
.OnAction = ThisWorkbook.Name & "!Popup_Click"
.Parameter = "Cards/Red Cards/Diamond"
End With
End With
With .Controls.Add(Type:=msoControlPopup)
.Caption = "Black Cards"
With .CommandBar.Controls.Add(Type:=msoControlButton)
.FaceId = 483
.Caption = "Spade"
.OnAction = ThisWorkbook.Name & "!Popup_Click"
.Parameter = "Cards/Black Cards/Spade"
End With
With .CommandBar.Controls.Add(Type:=msoControlButton)
.FaceId = 484
.Caption = "Club"
.OnAction = ThisWorkbook.Name & "!Popup_Click"
.Parameter = "Cards/Black Cards/Club"
End With
End With
End With
bar.Visible = True
End Sub
Sub Button_Click()
With Application.CommandBars.ActionControl
MsgBox "You clicked on button " & .Parameter
End With
End Sub
Sub Toggle_Click()
With Application.CommandBars.ActionControl
If .State = msoButtonUp Then
.FaceId = 135
.State = msoButtonDown
Else
.FaceId = 134
.State = msoButtonUp
End If
MsgBox .Parameter & " toggled"
End With
End Sub
Sub Edit_Enter()
With Application.CommandBars.ActionControl
MsgBox "Edit of control: " & .Parameter & vbNewLine & _
"You typed: " & .Text
End With
End Sub
Sub Dropdown_Click()
With Application.CommandBars.ActionControl
MsgBox "You selected: " & .Parameter & vbNewLine & _
"Has text: " & .Text
End With
End Sub
Sub ComboBox_Click()
With Application.CommandBars.ActionControl
MsgBox "You selected: " & .Parameter & vbNewLine & _
"Has text: " & .Text
End With
End Sub
Sub Popup_Click()
With Application.CommandBars.ActionControl
MsgBox "You selected: " & .Parameter & vbNewLine & _
"Has caption: " & .Caption
End With
End Sub
