Hello,

I'm looking to add toolbar and then a button inside that toolbar that will be linked to a script using vba. Baiscally, on excel start a toolbar would be placed at the end of the existing ones at the top that would have a button named Run and would be linked to a macro named play. On close I want that to be deleted.

Hi

I think this is nearly what you want. Create a workbook and put the first part of the code in ThisWorkbook module, and the second part in a standard code module.

Save the working program in the folder set in Excel as the one where all files will be opened at Startup.

This is actually a cut down version of some code I use, so I've left some extras in that save the position of the command bar in the Registry and use this information when the workbook is opened.

Good luck

Peter Mo.

'====================================================================
'
' ThisWorkbook module
'
'====================================================================
Option Explicit

Dim myCbr As CommandBar

'--------------------------------------------------------------------
Private Sub Workbook_BeforeClose(Cancel As Boolean)
' tidy everything up

' save position on command bar

SaveSetting strAppName, strStartup, strCBPosn, myCbr.Position
SaveSetting strAppName, strStartup, strCBTop, myCbr.Top
SaveSetting strAppName, strStartup, strCBLeft, myCbr.Left

' delete command bar

Call CBDeleteCommandBar(strMyCMB)

End Sub

'--------------------------------------------------------------------
Private Sub Workbook_Open()

' create command bar using position we had last time

Set myCbr = CreateCustomCommandBar(strMyCMB, _
GetSetting(strAppName, strStartup, strCBPosn, CBDefaultPosn), _
GetSetting(strAppName, strStartup, strCBTop, CBDefaultTop), _
GetSetting(strAppName, strStartup, strCBLeft, CBDefaultLeft))

' add button

Call AddButton(myCbr, strRun, strRunCode)

End Sub

'====================================================================
'
' Code Module
'
'====================================================================
Option Explicit

' Command Bar and Button Names

Public Const strMyCMB As String = "MyCommandBar"
Public Const strRun As String = "Run"
Public Const strRunCode As String = "RunCode"

' Registry Info

Public Const strAppName As String = "MyName"
Public Const strStartup As String = "Startup"
Public Const strCBPosn As String = "Position"
Public Const strCBTop As String = "Top"
Public Const strCBLeft As String = "Left"

' Default Command Bar Position

Public Const CBDefaultPosn As Long = msoBarTop
Public Const CBDefaultTop As Long = 0
Public Const CBDefaultLeft As Long = 0

'-------------------------------------------------------------------------
Function RunCode()
' Come here when the user click run button

MsgBox "Run Code"

End Function

'-------------------------------------------------------------------------
Function CreateCustomCommandBar(argCommandBar As String, _
argPosn As Long, argTop As Long, argLeft As Long) As CommandBar
' Create Custom CommandBar

Dim cbrNew As CommandBar
Dim ctlCBarControl As CommandBarControl
Dim myVar As String
Dim lngCnt As Long

If CBDoesCBExist(argCommandBar) Then
Call CBDeleteCommandBar(argCommandBar)
End If

Set cbrNew = Application.CommandBars.Add(Name:=argCommandBar)

With cbrNew
.Visible = True
.Position = argPosn
.Top = argTop
.Left = argLeft
End With

Set CreateCustomCommandBar = cbrNew

End Function

'-------------------------------------------------------------------------
Sub AddButton(argCbr As CommandBar, argCaption As String, argOnAction As String)
' add button to custom CommandBar

Dim ctlCBarControl As CommandBarControl

With argCbr
Set ctlCBarControl = .Controls.Add(msoControlButton)
With ctlCBarControl
.Caption = argCaption
.Style = msoButtonCaption
.BeginGroup = True
.Enabled = True
.OnAction = argOnAction
.Parameter = argCaption
End With
End With

End Sub

'-------------------------------------------------------------------------
Function CBDoesCBExist(strCBarName As String) As Boolean
' Check for existence of command bar with name strCBarName

Dim cbrBar As CommandBar

On Error Resume Next
Set cbrBar = CommandBars(strCBarName)
If Err = 0 Then
CBDoesCBExist = True
Else
CBDoesCBExist = False
End If

End Function

'-------------------------------------------------------------------------
Sub CBDeleteCommandBar(strCBarName As String)
' Delete the command bar specified by strCBarName. If the
' command bar does not exist, an error will occur and that
' error is ignored here.

On Error Resume Next
Application.CommandBars(strCBarName).Delete

End Sub