Saving custom toolbars with macros to work on other computers

  • Thread starter Thread starter Guest
  • Start date Start date
G

Guest

Hi
I have created a series of Macros in excel, and have alocated them to a
custom toolbar I have made. Is there a way which I can save the toolbar and
macros with the excel spreadsheet, so tht the whole set-up can be used on a
seperate computer?
 
Macros are always saved with the workbook that they are in. To attach a
toolbar to that workbook you use View, Toolbars, Customize and click the
Attach button on the Toolbars tab. Then Save the workbook.

That's the easy way but it has some drawbacks. If you make a change to the
toolbar (like adding a new button) you must remember to re-attach the
toolbar to the workbook. Making such a change and saving the workbook is
not enough, you must Attach again (when you change the toolbar, not the
code). Also, if you send someone the workbook he will see your toolbar when
he opens the workbook. But then that toolbar will become part of his
toolbar set, with or without your workbook. If he deleted your workbook the
toolbar would still be there and he'd get an error if he used it. Another
problem is that if you modify the toolbar, reattached it to the workbook and
send the workbook to a current user, when he opens it he will still see the
old toolbar. This is because he already has a toolbar with the same name
(your old one) and the old one blocks the new one. Before he opens your
workbook he has to delete the old toolbar manually. To make that
unnecessary you should add an auto_close macro to your workbook that deletes
the toolbar, so that the toolbar is never saved with the user's toolbar set.

To avoid all these issues the pros do not attach toolbars to workbooks.
Instead they build the toolbar with VBA code that's executed when the
workbook opens. That's a subject that goes beyond the scope of this
message<g>.

--
Jim
| Hi
| I have created a series of Macros in excel, and have alocated them to a
| custom toolbar I have made. Is there a way which I can save the toolbar
and
| macros with the excel spreadsheet, so tht the whole set-up can be used on
a
| seperate computer?
 
Hi Dave,

I have used your method to add a custom toolbar and it is awesome. I have
one problem, however, in that the macros assigned to the buttons (which work
independently) now do not function properly.

There are three macros which are essentially the same: they insert a row and
add text to column c; indent, color, font.

Can you please help me to determine why the macros are not working with the
toolbar?
 
If the macros haven't changed, then I don't know why there are different
results.

Maybe you should be more specific. Post the portion of code that doesn't work
the way it should and explain what it should be doing.
 
Dave,

Thank you for your quick reply; sorry if I didn't provide enough information
- I was trying to keep the post short. Here is the information you asked for:

From your code (modified with macro name in place of "mac1", "mac2", etc.):

Sub create_menubar()
Dim i As Long
Dim mac_names As Variant
Dim cap_names As Variant
Dim tip_text As Variant
Call remove_menubar
mac_names = Array("Insert_Level2_Task()", _
"Insert_Level3_Task()", _
"Insert_Level4_Task()", _
"OpenCalendar")
cap_names = Array("Level 2 Task", _
"Level 3 Task", _
"Level 4 Task", _
"Calendar")
tip_text = Array("Insert Level 2 Task", _
"Insert Level 3 Task", _
"Insert Level 4 Task", _
"Select a Date")
With Application.CommandBars.Add
.Name = "Project Management"

The subroutine itself (there are three) runs properly although when using
the floating toolbar it does not. I will first give you the code for the sub
and then explain what it does and what it does not do when using the toolbar.

Sub to insert level 2 task:

Sub Insert_Level2_Task()

' Insert_Level2_Task Macro
' Click here to insert a level 2 task
Dim r As String
Dim length As Integer
Dim posit As Integer
Dim p As String
Dim res As Integer

res = MsgBox("Insert Level 2 Task?", vbYesNo, "Insert New Task")
If res = vbYes Then

r = ActiveWindow.RangeSelection.Address
length = Len(r)
posit = InStr(1, r, ":")
p = Left(r, length - posit)
length = Len(p)
r = Right(p, length - 1)

Rows(ActiveWindow.RangeSelection.Address).Select
Selection.Insert Shift:=xlDown
Range(ActiveWindow.RangeSelection.Address).Select
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 1
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
.Font.Italic = True
End With
Range("c" & r).Select
Selection.Font.Color = 16711680
ActiveCell.FormulaR1C1 = "new level 2 task"
Range("a1").Select
End If
End Sub

What the macro does:
This sub brings up a msg box (Y/N) and aks the user if they would like to
insert a new level 2 taks; result of Y: inserts a new row; inserts text: "new
level 2 task" in column C; indents the cell; and applies color (blue) and
font (italic) to the text

What happens when run from the toolbar:
the msg box is displayed, but doesn't function properly. Clicking Yes
results: the row does not appear to be added; the text "new level 2 task" is
entered in the first cell without the formatting (color, font). The msg box
also requires 2 clicks (whether yes or no) to end (disappear).

You should know, also, that the opencalendar sub does work properly.

I am sorry if I took up too much space here, but your help would be greatly
appreciated.
 
I don't see anything that jumps out as an error.

Is there any chance you had multiple macros (when you were developing) with the
same name? Maybe you're calling different ones.

I'd add this to the top of each macro--before any processing starts:

Msgbox thisworkbook.fullname

If you don't get the message, then you haven't found the macro that's currently
running.

If you do see the message, did you expect to see that name of the workbook?



penGuin_1 said:
Dave,

Thank you for your quick reply; sorry if I didn't provide enough information
- I was trying to keep the post short. Here is the information you asked for:

From your code (modified with macro name in place of "mac1", "mac2", etc.):

Sub create_menubar()
Dim i As Long
Dim mac_names As Variant
Dim cap_names As Variant
Dim tip_text As Variant
Call remove_menubar
mac_names = Array("Insert_Level2_Task()", _
"Insert_Level3_Task()", _
"Insert_Level4_Task()", _
"OpenCalendar")
cap_names = Array("Level 2 Task", _
"Level 3 Task", _
"Level 4 Task", _
"Calendar")
tip_text = Array("Insert Level 2 Task", _
"Insert Level 3 Task", _
"Insert Level 4 Task", _
"Select a Date")
With Application.CommandBars.Add
.Name = "Project Management"

The subroutine itself (there are three) runs properly although when using
the floating toolbar it does not. I will first give you the code for the sub
and then explain what it does and what it does not do when using the toolbar.

Sub to insert level 2 task:

Sub Insert_Level2_Task()

' Insert_Level2_Task Macro
' Click here to insert a level 2 task
Dim r As String
Dim length As Integer
Dim posit As Integer
Dim p As String
Dim res As Integer

res = MsgBox("Insert Level 2 Task?", vbYesNo, "Insert New Task")
If res = vbYes Then

r = ActiveWindow.RangeSelection.Address
length = Len(r)
posit = InStr(1, r, ":")
p = Left(r, length - posit)
length = Len(p)
r = Right(p, length - 1)

Rows(ActiveWindow.RangeSelection.Address).Select
Selection.Insert Shift:=xlDown
Range(ActiveWindow.RangeSelection.Address).Select
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 1
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
.Font.Italic = True
End With
Range("c" & r).Select
Selection.Font.Color = 16711680
ActiveCell.FormulaR1C1 = "new level 2 task"
Range("a1").Select
End If
End Sub

What the macro does:
This sub brings up a msg box (Y/N) and aks the user if they would like to
insert a new level 2 taks; result of Y: inserts a new row; inserts text: "new
level 2 task" in column C; indents the cell; and applies color (blue) and
font (italic) to the text

What happens when run from the toolbar:
the msg box is displayed, but doesn't function properly. Clicking Yes
results: the row does not appear to be added; the text "new level 2 task" is
entered in the first cell without the formatting (color, font). The msg box
also requires 2 clicks (whether yes or no) to end (disappear).

You should know, also, that the opencalendar sub does work properly.

I am sorry if I took up too much space here, but your help would be greatly
appreciated.
Click to expand...
 
Dave, I added the msgbox as you suggested and all macros appear to be called
correctly. I am really puzzled because they run correctly independent of the
toolbar, but it seems almost as if they are trying to run twice from the
toolbar. Since we can't isolate with part of the code, I have copied and
pasted the entire module below. Please note, this is my first serious work
with macros and I would consider myself to be a novice, though I learn well.

Here is the code (entirely) from my module - please see if you can help:

Option Explicit

Sub create_menubar()
Dim i As Long
Dim mac_names As Variant
Dim cap_names As Variant
Dim tip_text As Variant

'MsgBox ThisWorkbook.FullName

Call remove_menubar
mac_names = Array("Insert_Level2_Task()", _
"Insert_Level3_Task()", _
"Insert_Level4_Task()", _
"OpenCalendar")
cap_names = Array("Level 2 Task", _
"Level 3 Task", _
"Level 4 Task", _
"Calendar")
tip_text = Array("Insert Level 2 Task", _
"Insert Level 3 Task", _
"Insert Level 4 Task", _
"Select a Date")
With Application.CommandBars.Add
.Name = "Project Management"
.Left = 200
.Top = 200
.Protection = msoBarNoProtection
.Visible = True
.Position = msoBarFloating
For i = LBound(mac_names) To UBound(mac_names)
With .Controls.Add(Type:=msoControlButton)
.OnAction = ThisWorkbook.Name & "!" & mac_names(i)
.Caption = cap_names(i)
.Style = msoButtonIconAndCaption
.FaceId = 0
.TooltipText = tip_text(i)
End With
Next i
End With
End Sub
Sub remove_menubar()
On Error Resume Next
Application.CommandBars("Project Management").Delete
On Error GoTo 0
End Sub


Sub OpenCalendar()
Calendar.Show
End Sub

Sub Insert_Level3_Task()

' Insert_Level3_Task Macro
' Click here to insert a level 3 task

Dim r As String
Dim length As Integer
Dim posit As Integer
Dim p As String
Dim res As Integer

'MsgBox ThisWorkbook.FullName

res = MsgBox("Insert Level 3 Task?", vbYesNo, "Insert New Task")
If res = vbYes Then

r = ActiveWindow.RangeSelection.Address
length = Len(r)
posit = InStr(1, r, ":")
p = Left(r, length - posit)
length = Len(p)
r = Right(p, length - 1)

Rows(ActiveWindow.RangeSelection.Address).Select
Selection.Insert Shift:=xlDown
Range(ActiveWindow.RangeSelection.Address).Select
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 2
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
.Font.Italic = False
End With
Range("c" & r).Select
Selection.Font.Color = 255
ActiveCell.FormulaR1C1 = "new level 3 task"
Range("a1").Select
End If
End Sub

Sub Insert_Level2_Task()

' Insert_Level2_Task Macro
' Click here to insert a level 2 task
Dim r As String
Dim length As Integer
Dim posit As Integer
Dim p As String
Dim res As Integer

'MsgBox ThisWorkbook.FullName

res = MsgBox("Insert Level 2 Task?", vbYesNo, "Insert New Task")
If res = vbYes Then

r = ActiveWindow.RangeSelection.Address
length = Len(r)
posit = InStr(1, r, ":")
p = Left(r, length - posit)
length = Len(p)
r = Right(p, length - 1)

Rows(ActiveWindow.RangeSelection.Address).Select
Selection.Insert Shift:=xlDown
Range(ActiveWindow.RangeSelection.Address).Select
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 1
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
.Font.Italic = True
End With
Range("c" & r).Select
Selection.Font.Color = 16711680
ActiveCell.FormulaR1C1 = "new level 2 task"
Range("a1").Select
End If
End Sub

Sub Insert_Level4_Task()

' Insert_Level4_Task Macro
' Click here to insert a level 4 task
Dim r As String
Dim length As Integer
Dim posit As Integer
Dim p As String
Dim res As Integer

'MsgBox ThisWorkbook.FullName

res = MsgBox("Insert Level 4 Task?", vbYesNo, "Insert New Task")
If res = vbYes Then

r = ActiveWindow.RangeSelection.Address
length = Len(r)
posit = InStr(1, r, ":")
p = Left(r, length - posit)
length = Len(p)
r = Right(p, length - 1)

Rows(ActiveWindow.RangeSelection.Address).Select
Selection.Insert Shift:=xlDown
Range(ActiveWindow.RangeSelection.Address).Select
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 3
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
.Font.Italic = False
End With
Range("c" & r).Select
Selection.Font.Color = 255
ActiveCell.FormulaR1C1 = "new level 4 task"
Range("a1").Select
End If
End Sub


That's all of it besides the workbook commands you have for the toolbar.

I really appreciate your help.
 
I still don't see anything in the code that would make it work differently
depending on how it was called.

One guess. Do you have merged cells in your worksheet?

I don't use them (I don't like them!). But they seem to work differently when
you do things manually as opposed through code. (Although, I've never seen them
work differently based on how the code was called!)

I'm afraid I don't have any guesses.

penGuin_1 said:
Dave, I added the msgbox as you suggested and all macros appear to be called
correctly. I am really puzzled because they run correctly independent of the
toolbar, but it seems almost as if they are trying to run twice from the
toolbar. Since we can't isolate with part of the code, I have copied and
pasted the entire module below. Please note, this is my first serious work
with macros and I would consider myself to be a novice, though I learn well.

Here is the code (entirely) from my module - please see if you can help:

Option Explicit

Sub create_menubar()
Dim i As Long
Dim mac_names As Variant
Dim cap_names As Variant
Dim tip_text As Variant

'MsgBox ThisWorkbook.FullName

Call remove_menubar
mac_names = Array("Insert_Level2_Task()", _
"Insert_Level3_Task()", _
"Insert_Level4_Task()", _
"OpenCalendar")
cap_names = Array("Level 2 Task", _
"Level 3 Task", _
"Level 4 Task", _
"Calendar")
tip_text = Array("Insert Level 2 Task", _
"Insert Level 3 Task", _
"Insert Level 4 Task", _
"Select a Date")
With Application.CommandBars.Add
.Name = "Project Management"
.Left = 200
.Top = 200
.Protection = msoBarNoProtection
.Visible = True
.Position = msoBarFloating
For i = LBound(mac_names) To UBound(mac_names)
With .Controls.Add(Type:=msoControlButton)
.OnAction = ThisWorkbook.Name & "!" & mac_names(i)
.Caption = cap_names(i)
.Style = msoButtonIconAndCaption
.FaceId = 0
.TooltipText = tip_text(i)
End With
Next i
End With
End Sub
Sub remove_menubar()
On Error Resume Next
Application.CommandBars("Project Management").Delete
On Error GoTo 0
End Sub

Sub OpenCalendar()
Calendar.Show
End Sub

Sub Insert_Level3_Task()

' Insert_Level3_Task Macro
' Click here to insert a level 3 task

Dim r As String
Dim length As Integer
Dim posit As Integer
Dim p As String
Dim res As Integer

'MsgBox ThisWorkbook.FullName

res = MsgBox("Insert Level 3 Task?", vbYesNo, "Insert New Task")
If res = vbYes Then

r = ActiveWindow.RangeSelection.Address
length = Len(r)
posit = InStr(1, r, ":")
p = Left(r, length - posit)
length = Len(p)
r = Right(p, length - 1)

Rows(ActiveWindow.RangeSelection.Address).Select
Selection.Insert Shift:=xlDown
Range(ActiveWindow.RangeSelection.Address).Select
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 2
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
.Font.Italic = False
End With
Range("c" & r).Select
Selection.Font.Color = 255
ActiveCell.FormulaR1C1 = "new level 3 task"
Range("a1").Select
End If
End Sub

Sub Insert_Level2_Task()

' Insert_Level2_Task Macro
' Click here to insert a level 2 task
Dim r As String
Dim length As Integer
Dim posit As Integer
Dim p As String
Dim res As Integer

'MsgBox ThisWorkbook.FullName

res = MsgBox("Insert Level 2 Task?", vbYesNo, "Insert New Task")
If res = vbYes Then

r = ActiveWindow.RangeSelection.Address
length = Len(r)
posit = InStr(1, r, ":")
p = Left(r, length - posit)
length = Len(p)
r = Right(p, length - 1)

Rows(ActiveWindow.RangeSelection.Address).Select
Selection.Insert Shift:=xlDown
Range(ActiveWindow.RangeSelection.Address).Select
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 1
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
.Font.Italic = True
End With
Range("c" & r).Select
Selection.Font.Color = 16711680
ActiveCell.FormulaR1C1 = "new level 2 task"
Range("a1").Select
End If
End Sub

Sub Insert_Level4_Task()

' Insert_Level4_Task Macro
' Click here to insert a level 4 task
Dim r As String
Dim length As Integer
Dim posit As Integer
Dim p As String
Dim res As Integer

'MsgBox ThisWorkbook.FullName

res = MsgBox("Insert Level 4 Task?", vbYesNo, "Insert New Task")
If res = vbYes Then

r = ActiveWindow.RangeSelection.Address
length = Len(r)
posit = InStr(1, r, ":")
p = Left(r, length - posit)
length = Len(p)
r = Right(p, length - 1)

Rows(ActiveWindow.RangeSelection.Address).Select
Selection.Insert Shift:=xlDown
Range(ActiveWindow.RangeSelection.Address).Select
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 3
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
.Font.Italic = False
End With
Range("c" & r).Select
Selection.Font.Color = 255
ActiveCell.FormulaR1C1 = "new level 4 task"
Range("a1").Select
End If
End Sub

That's all of it besides the workbook commands you have for the toolbar.

I really appreciate your help.
Click to expand...
 
Dave,

I don't have any merged cells (that I created or that I can find). I used
some data validation on cells and some vlookup, but I can't figure it out,
either.

I really appreciate your time and effort - I guess I will keep working it
out...
 
Good luck.

If you find the problem, please post back. Then google will have the answer for
the next person.
 
Back
Top