View Single Post
  #13   Report Post  
Posted to microsoft.public.excel.programming
Dave Peterson Dave Peterson is offline
external usenet poster
 
Posts: 35,218
Default Worksheet with its own toolbar

Glad you got it working.

But I put each of your routines in a separate General Module (not behind a
worksheet, not behind thisWorkbook) and your code worked perfectly for me.

But I, too, would put all the code in a single general module -- since it's all
related to building/deleting that toolbar, it makes more organizational sense to
me.

Francis Hookham wrote:

Fantastic - I wish I had stuck with it some years ago.

Thanks Dave and Paul

Francis Hookham

xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx xx
For anyone interested here it is - I found it had to be in its own Module
otherwise it did not work
xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx xx
Option Explicit
Sub create_menubar()
'With thanks to Dave Peterson and Paul B in
'nsnews.microsoft.public.excel.programming
'for much help patience and pointing me in the right direction in May '07
'This first section relates to the 'Main toolbar'
Application.ScreenUpdating = False
Dim i As Long
Dim DoorMacros As Variant 'macro names
Dim DoorCaptions As Variant 'what's on button
Dim DoorTips As Variant 'tip which comes up on mouse-over
'...these are the macros to be called when the button is clicked
DoorMacros = Array("Preparation", _
"TransferSpecsToSched", _
"WindowSchedule", _
"WindowPages", _
"WindowSpecs", _
"WindowAddVert", _
"WindowAddHori", _
"WindowsVertical", _
"WindowsHorizontal", _
"MaxWindow")
'...these are the captions bside each icon in the button
'...they could be left out if icon alone is enough
DoorCaptions = Array("New job", _
"SpecSched", _
"Sched", _
"Pages", _
"Specs", _
"Opens V", _
"Open H", _
"Vert", _
"Hori", _
"Maxi")
'...these are the tips which appear when the mouse hovers over the button
DoorTips = Array("BEWARE - this clears everything and starts a new job",
_
"Transfers specifications to Schedule sheet heading
rows", _
"Makes active the Schedule sheet", _
"Makes active the Pages sheet", _
"Makes active the Specs sheet", _
"Opens another sheet vertically", _
"Opens another sheet horizontally", _
"Arranges sheets vertically", _
"Arranges sheets horizontally", _
"Maximises active sheet")
With Application.CommandBars.Add
'...name of toolbar .Name = "Main toolbar"
'...toolbar can open where wanted:-
' .Left = 200
' .Top = 200
.Protection = msoBarNoProtection
.Visible = True
' .Position = msoBarFloating
.Position = msoBarTop
' .Position = msoBarBottom
'...having set up most of the details the toolbar is displayed
For i = LBound(DoorMacros) To UBound(DoorMacros)
Worksheets("Store").Pictures("M" & i + 1).Copy
'...the 16x16 button images (icons) are brought in one by one
'...from the (hidden) sheet "Store"
With .Controls.Add(Type:=msoControlButton)
.OnAction = ThisWorkbook.Name & "!" & DoorMacros(i)
.Caption = DoorCaptions(i)
.Style = msoButtonIconAndCaption
.PasteFace
.TooltipText = DoorTips(i)
End With
Next i
End With
End Sub

Sub auto_open()
create_menubar
End Sub

Sub auto_close()
remove_menubar
End Sub

Sub remove_menubar()
On Error Resume Next
Application.CommandBars("Main toolbar").Delete
On Error GoTo 0
End Sub


--

Dave Peterson