Re: Saving custom toolbars with macros to work on other computers

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.

--
- thank you
penGuin_1


"Dave Peterson" wrote:

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 wrote:

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.
--
- thank you
penGuin_1

"Dave Peterson" wrote:

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.

penGuin_1 wrote:

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?

--
- thank you
penGuin_1

"Dave Peterson" wrote:

Just to add to Jim's reply.

Here's how I create that toolbar on the fly:
http://groups.google.co.uk/groups?threadm=40E095F1.5CB35B41%40msn.com

If you want to add items to the work*** menu bar, you can use John
Walkenbach's menumaker:
http://j-walk.com/ss/excel/tips/tip53.htm

jpw48 wrote:

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 spread***, so tht the whole set-up can be used on a
seperate computer?

--

Dave Peterson


--

Dave Peterson


--

Dave Peterson

.

Loading