Mega Code Archive
Add a new commandbar
<![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(Type:=msoControlButton)
With myCommandBarCtl
.Caption = "Button"
.Style = msoButtonCaption
.TooltipText = "Display Message Box"
.OnAction = "=MsgBox(""You pressed a toolbar button!"")"
End With
Set myCommandBarCtl = myCommandBar.Controls.Add(Type:=msoControlButton)
With myCommandBarCtl
.FaceId = 1000
.Caption = "Toggle Button"
.TooltipText = "Toggle First Button"
.OnAction = "=ToggleButton()"
End With
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:
Debug.Print Err.number & vbCr & Err.Description
Exit Sub
End Sub
Function ToggleButton()
Dim CBButton As CommandBarControl
On Error GoTo ToggleButton_Err
Set CBButton = CommandBars("Sample Toolbar").Controls(1)
CBButton.Visible = Not CBButton.Visible
Exit Function
ToggleButton_Err:
Debug.Print Err.number & vbCr & Err.Description
Exit Function
End Function
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
Debug.Print "Cannot remove button that does not exist!"
Exit Function
Else
Debug.Print Err.number & vbCr & Err.Description
Exit Function
End If
End Function
]]>