Is there any way I can create a command button that floats over severa
sheets instead of having to make the same command button and put it o
50 different sheets
Here is some sample code from one of my add-ins. Modify it to create a
toolbar instead of adding buttons to menu items (this code adds a
pop-up (submenu) and two commands to the Tools menu in Excel)
Option Explicit
' Procedure : AddFreezePopUp
' DateTime : 6/6/2006 19:34
' Author : Johnny Meredith
' Email :
' Purpose : Add Freeze pop-up menu to Tools menu in Excel
' Parameters: N/A
'---------------------------------------------------------------------------------------
Public Sub AddFreezePopUp()
On Error Resume Next
Dim cbmMenuBar As CommandBarPopup 'Main
menu bar
Dim cbcMenuItem As CommandBarPopup 'New
menu item
' Remove menu item if it exists.
Application.CommandBars(cMenuBarName).Controls("Tools") _
..Controls("Freeze").Delete
'Identify menu bar that will receive new item.
Set cbmMenuBar =
Application.CommandBars(cMenuBarName).Controls("Tools")
'Add menu item.
Set cbcMenuItem = cbmMenuBar.Controls.Add(Type:=msoControlPopup)
'Set property values of new menu item.
With cbcMenuItem
.Caption = "&Freeze"
.Tag = "Freeze"
End With
'Clean up references
Set cbmMenuBar = Nothing
Set cbcMenuItem = Nothing
End Sub
' Procedure : AddFreezeMenuItems
' DateTime : 6/6/2006 19:34
' Author : Johnny Meredith
' Email :
' Purpose : Add commands to new pop-up menu created in AddFreezePopUp
routine.
' Parameters: N/A
'---------------------------------------------------------------------------------------
Public Sub AddFreezeMenuItems()
On Error Resume Next
Dim cbmMenuBar As CommandBarPopup
'Main menu bar
Dim cbmFreezeMenu As CommandBarPopup
'New freeze popup
Dim cbcFreeze As CommandBarButton
'New freeze command
Dim cbcManage As CommandBarButton
'New manage command
'Remove menu item if it exists.
'Identify menu bar that will receive new item.
Set cbmMenuBar =
Application.CommandBars(cMenuBarName).Controls("Tools")
Set cbmFreezeMenu = cbmMenuBar.Controls("Freeze")
'Add menu item.
Set cbcFreeze = cbmFreezeMenu.Controls.Add(Type:=msoControlButton)
Set cbcManage = cbmFreezeMenu.Controls.Add(Type:=msoControlButton)
'Set property values of menu item.
'Freeze command
With cbcFreeze
.Caption = "Free&ze..."
.Tag = "Freeze"
.OnAction = "FreezeEntry"
End With
'Manage command
With cbcManage
.Caption = "&Manage..."
.Tag = "Manage"
.OnAction = "ManageEntry"
End With
'Clean up references
Set cbmMenuBar = Nothing
Set cbmFreezeMenu = Nothing
Set cbcFreeze = Nothing
Set cbcManage = Nothing
End Sub
' Procedure : DeleteCustomMenus
' DateTime : 6/6/2006 19:42
' Author : Johnny Meredith
' Email :
' Purpose : Remove custom pop-ups and commands added in
AddFreezePopUp &
' AddFreezeMenuItems routines
' Parameters: N/A
'---------------------------------------------------------------------------------------
Public Sub DeleteCustomMenus()
On Error Resume Next
Dim cbmMenuBar As CommandBarPopup
'Mail menu bar
Dim cbmFreezeMenu As CommandBarPopup
'Custom menu
'Delete Freeze pop-up
Set cbmMenuBar = Application.CommandBars("Worksheet Menu
Bar").Controls("Tools")
Set cbmFreezeMenu = cbmMenuBar.Controls("Freeze")
cbmFreezeMenu.Delete
End Sub
'Entry points for new commands
Public Function FreezeEntry()
On Error Resume Next
frmFreeze.Show
End Function
Public Function ManageEntry()
On Error Resume Next
frmManage.Show
End Function
This is very basic but it should give you a start... this code needs to be in
a standard code module.
Private Const MyBarName As String = "My Command Bar"
Public Sub AddMyBar()
Dim cbrMyBar As CommandBar
Dim btn As CommandBarButton
Set cbrMyBar = Application.CommandBars.Add(MyBarName)
cbrMyBar.Visible = True
Set btn = cbrMyBar.Controls.Add(Type:=msoControlButton)
With btn
.Style = msoButtonCaption
.Caption = "Tada"
.OnAction = "DoStuff"
End With
End Sub
Public Sub DeleteMyBar()
On Error Resume Next
Application.CommandBars(MyBarName).Delete
End Sub
