Sleeper: Custom Toolbars

[Jack Feeman]

HI,

I designed an Excel Form which included a custom toolbar which I created from the Excel UI (Tools>Customize>New). I recorded macros to accomplish some specific tasks and saved them to the Workbook. I then used the UI to assign a task to each of the buttons I created for the custom toolbar. Problem: everytime, I e-mailed or distributed the file, the toolbar buttons could not find the macros since the referenced location of the macros had shifted to the new location of the file. However, if I physically went to that machine and reassigned the macros the buttons would work fine. Yet if they sent to to someone the same problem would appear.

After months of trying everything under the sun, I tried some suggestions and they were created in the VB Editor. Now I get the toolbar, but it is not detachable and I cannot find how to make the custom toolbar detachable. Here is the code used to create the toolbar:

Sub addToolbar()
Dim oCBMenuBar As CommandBar
Dim oCBCLeave As CommandBarControl
Dim iMenu As Integer
Dim i As Integer
On Error Resume Next
    Application.CommandBars("PTB").Delete
    Set oCBMenuBar = Application.CommandBars.Add(Name:="PTB")
        With oCBMenuBar
            With .Controls.Add(Type:=msoControlButton)
                .BeginGroup = True
                .Caption = " Add DMA "
                .Style = msoButtonCaption
                .TooltipText = "Add another DMA/NTA to the Proposal"
                .OnAction = "AddDMA"
        End With
        With .Controls.Add(Type:=msoControlButton)
            .Caption = " Print Proposal "
            .Style = msoButtonCaption
            .TooltipText = "Always use this button to print the proposal"
            .OnAction = "Autoprint"
        End With
        With .Controls.Add(Type:=msoControlButton)
            .Caption = " New Proposal "
            .Style = msoButtonCaption
            .TooltipText = "Create another Proposal"
            .OnAction = "NewProposal"
        End With
        With .Controls.Add(Type:=msoControlButton)
            .Caption = " Print Instructions "
            .Style = msoButtonCaption
            .TooltipText = "Print the instructions for using this tool"
            .OnAction = "PrintInstructions"
        End With
            .Position = msoBarTop
            .Protection = msoBarNoMove
            .Visible = True
        End With
End Sub
Sub deleteToolbar()
On Error Resume Next
    Application.CommandBars("PTB").Delete
End Sub

Any help would be much appreciated.
Jack

[Tommy]

Hi Jack,


Welcolme to VBAX!!

try changing this:

.Protection = msoBarNoMove

to this:

'.Protection = msoBarNoMove

since you are setting the protection to msoBarNoMove you cannot move it, so take it out and you can move it, float it, etc

HTH

[Jack Feeman]

Hi Jack,


Welcolme to VBAX!!

try changing this:

.Protection = msoBarNoMove

to this:

'.Protection = msoBarNoMove

since you are setting the protection to msoBarNoMove you cannot move it, so take it out and you can move it, float it, etc

HTH

Thanks so much Tommy!

[Jack Feeman]

Tommy,

That certainly fixed the problem, but I see that it does not keep a vertical orientation when the file is reopened. I commented out the line "' .Position = msoBarTop" as well and it opens detached but hortizontally oriented. Previous ones opened when I put it; to the upper right of the last active column. Do I need to reinstate the above line changed in some one or use a new command to get the custom tool bar to stay put.

Thanks again.

Jack

[Tommy]

I save my toolbar setting to the regestry so the user can move it where they want it. So when I create the toolbar I read the regestry and put the toolbar where ever it points.

The below is MY prefered method. I say MY because I have seen several different ways to do this, I have copied several ways to do this, I have changed, edited, deleted, added, so I have no idea who actually wrote what or where I got some of it. I use this a lot and I also use it for a base when adding toolbars in the VBIDE or COM ADD-INs. So in a nutshell this works very well for me

Option Explicit
Public Const TOOLBAR_NAME As String = "Certification Letter"
Public MyButton As CommandBarButton
Public MyButton1 As CommandBarButton
Public MyButton2 As CommandBarButton

Public Sub AddToolBar()
On Error Resume Next
Dim I As Integer
Dim J As Integer
Dim sToolBar As String
On Error Resume Next
sToolBar = Application.CommandBars(TOOLBAR_NAME).Name
If Err.Number <> 0 Then
Application.CommandBars.Add TOOLBAR_NAME, , , True
Call SetLocation(TOOLBAR_NAME)
End If
Application.CommandBars(TOOLBAR_NAME).Visible = True
I = Application.CommandBars(TOOLBAR_NAME).Controls.Count
For J = I To 1 Step -1
Application.CommandBars(TOOLBAR_NAME).Controls(J).Delete
Next
On Error GoTo 0
If MyButton Is Nothing Then
Set MyButton = Application.CommandBars(TOOLBAR_NAME).Controls.Add(1)
End If
With MyButton
.Caption = "Enter Data"
.Style = msoButtonIconAndCaption 'icon and caption
'.Style = msoButtonCaption 'caption only
'.Style = msoButtonIcon 'icon only
.Tag = "VBA CustomButtons"
.OnAction = "ShowFillIn"
.FaceId = 362
.Visible = True
End With
If MyButton1 Is Nothing Then
Set MyButton1 = Application.CommandBars(TOOLBAR_NAME).Controls.Add(1)
End If
With MyButton1
.Caption = "Add Contact"
.Style = msoButtonIconAndCaption
.Tag = "VBA CustomButton1"
.OnAction = "AddContact"
.FaceId = 3732
.Visible = True
End With
If MyButton2 Is Nothing Then
Set MyButton2 = Application.CommandBars(TOOLBAR_NAME).Controls.Add(1)
End If
With MyButton2
.Caption = "Change Contact"
.Style = msoButtonIconAndCaption
.Tag = "VBA CustomButton2"
.OnAction = "ChangeContact"
.FaceId = 3732
.Visible = True
End With
End Sub

Public Sub DeleteToolBar()
Dim I As Integer
Dim J As Integer
On Error Resume Next
Call SaveLocation(TOOLBAR_NAME)
I = Application.CommandBars(TOOLBAR_NAME).Controls.Count
For J = I To 1 Step -1
Application.CommandBars(TOOLBAR_NAME).Controls(J).Delete
Next
Set MyButton = Nothing
Set MyButton1 = Nothing
Application.CommandBars(TOOLBAR_NAME).Delete
Set RghtHer = Nothing
On Error GoTo 0
End Sub
 
Sub SetLocation(BarName As String)
Dim lToolbarPosition As Long
Dim lToolbarIndex As Long
Dim lToolbarTop As Long
Dim lToolbarLeft As Long
lToolbarPosition = CLng(GetSetting(TOOLBAR_NAME, "Settings", "ToolbarPosition", CStr(msoBarTop)))
lToolbarIndex = CLng(GetSetting(TOOLBAR_NAME, "Settings", "ToolbarIndex", "0"))
lToolbarLeft = CLng(GetSetting(TOOLBAR_NAME, "Settings", "ToolbarLeft", "0"))
lToolbarTop = CLng(GetSetting(TOOLBAR_NAME, "Settings", "ToolbarTop", "0"))
With Application.CommandBars(TOOLBAR_NAME)
.Position = lToolbarPosition
Select Case lToolbarPosition
Case msoBarTop, msoBarBottom
.RowIndex = lToolbarIndex
.Left = lToolbarLeft
Case msoBarLeft, msoBarRight
.RowIndex = lToolbarIndex
.Top = lToolbarTop
Case Else
.Top = lToolbarTop
.Left = lToolbarLeft
End Select
.Visible = True
End With
End Sub

Sub SaveLocation(BarName As String)
With Application.CommandBars(TOOLBAR_NAME)
SaveSetting TOOLBAR_NAME, "Settings", "ToolbarPosition", CStr(.Position)
SaveSetting TOOLBAR_NAME, "Settings", "ToolbarIndex", CStr(.RowIndex)
SaveSetting TOOLBAR_NAME, "Settings", "ToolbarLeft", CStr(.Left)
SaveSetting TOOLBAR_NAME, "Settings", "ToolbarTop", CStr(.Top)
.Visible = False
End With
End Sub

Function ShowFillIn()
frmFillIn.Show
End Function

[Jack Feeman]

Thanks Tommy......Have a great weekend.