View Single Post
  #4   Report Post  
Posted to microsoft.public.excel.programming
Johnny[_10_] Johnny[_10_] is offline
external usenet poster
 
Posts: 30
Default Floating Command button

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("To ols") _
..Controls("Freeze").Delete

'Identify menu bar that will receive new item.
Set cbmMenuBar =
Application.CommandBars(cMenuBarName).Controls("To ols")

'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("To ols")
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