Mega Code Archive
Creating a Toolbar
<![CDATA[
Sub AddNewCB()
Dim myCommandBar As CommandBar, myCommandBarCtl As CommandBarControl
On Error GoTo AddNewCB_Err
Set myCommandBar = CommandBars.Add(Name:="Sample Toolbar", Position:= _
msoBarFloating)
myCommandBar.Visible = True
Set myCommandBarCtl = myCommandBar.Controls.Add(msoControlComboBox)
With myCommandBarCtl
.Caption = "Drop Down"
.Width = 100
.AddItem "Create Button", 1
.AddItem "Remove Button", 2
.DropDownWidth = 100
.OnAction = "=AddRemoveButton()"
End With
Exit Sub
AddNewCB_Err:
msgBox "Error " & Err.number & vbCr & Err.Description
Exit Sub
End Sub
Function AddRemoveButton()
Dim myCommandBar As CommandBar, CBCombo As CommandBarComboBox
Dim CBNewButton As CommandBarButton
On Error GoTo AddRemoveButton_Err
Set myCommandBar = CommandBars("Sample Toolbar")
Set CBCombo = myCommandBar.Controls(3)
Select Case CBCombo.ListIndex
Case 1
Set CBNewButton = myCommandBar.Controls.Add(Type:=msoControlButton)
With CBNewButton
.Caption = "New Button"
.Style = msoButtonCaption
.BeginGroup = True
.Tag = "New Button"
.OnAction = "=MsgBox(""This is a new button!"")"
End With
Case 2
Set CBNewButton = myCommandBar.FindControl(Tag:="New Button")
CBNewButton.Delete
End Select
Exit Function
AddRemoveButton_Err:
If Err.number = 91 Then
msgBox "Cannot remove button that does not exist!"
Exit Function
Else
msgBox "Error " & Err.number & vbCr & Err.Description
Exit Function
End If
End Function
]]>