About Us

GB

Good to go? Taking a break?

"GB" wrote:

I did just try to close my workbook, I think for the first time since I
redesigned the code... It runs into a problem that is not yet handled.. My
fix for it was to revise the Thisworkbook code to read as follows:

Option Explicit
Dim Closing As Boolean

Private Sub Workbook_BeforeClose(Cancel As Boolean)
ToolBars2.All_Bars_Delete
Closing = True
End Sub

Private Sub Workbook_Open()
ToolBars2.All_Bars
End Sub

Private Sub Workbook_WindowActivate(ByVal Wn As Window)
ToolBars2.All_Bars
End Sub

Private Sub Workbook_WindowDeactivate(ByVal Wn As Window)
If Closing = False Then
ToolBars2.All_Bars_Hide
End If
End Sub

On closing, two routines are run, the first is the close sub routine, the
second is the windowdeactivate.

I guess in my development I didn't handle what happens if you try to hide a
non-existent toolbar. The change above (usage of the Closing boolean
variable) prevents trying to hide a deleted toolbar.

"GB" wrote:

Okay, job is done.

I have created the properties for three menubars. All of them call the
common toolbars subroutine, since you have three buttons that will be common
to all of them. Additionally, I streamlined the code a little so that the
number of sub routines that would need to be copied to add a toolbar is
reduced.

Basically I pass in the number for the toolbar that I want to show, or hide,
unless I want to show all or hide all.

It appears that it is important to call the All_Bars routine prior to being
able to getting any toolbar to appear. So like in the workbook open, if you
call Toolbars.All_Bars it will create all of the toolbars, and in that
instance activate sheet1. Could revise the sheet1.activate to
activeworksheet.activate. Sounds redundant, but it forces the activation
subroutine to occur showing and hiding the appropriate sheets.

Continue looking past this initial code, I also have provided an example of
what is necessary/I used in the code of one worksheet.

Here's the code of the Toolbars module:

'Top of code here.

Option Explicit

Private Const MAX_BARS As Integer = 10

Public Sub All_Bars()
Dim CurrentSheet As Worksheet
Dim sh As Worksheet

Application.ScreenUpdating = False

Tool_Bar0_Create
Tool_Bar1_Create
Tool_Bar2_Create

Set CurrentSheet = ActiveSheet

For Each sh In Worksheets
sh.Activate
Next

CurrentSheet.Activate
Application.ScreenUpdating = True
End Sub

Public Sub All_Bars_Delete()
Dim i As Integer

i = 0

On Error GoTo Out
Err.Clear

While (Name(i) < "" And i < Max_Tool_Bars)

Application.CommandBars(Name(i)).Delete

Out:
i = i + 1
Wend

Err.Clear
On Error GoTo 0
End Sub

Public Sub All_Bars_Hide()
Dim i As Integer
i = 0
While (Name(i) < "" And i < Max_Tool_Bars)
On Error GoTo Hide
Err.Clear
If Application.CommandBars(Name(i)).Visible = True Then
CommandBars(Name(i)).Visible = False
End If
Hide:
i = i + 1
Wend

Err.Clear
On Error GoTo 0

End Sub

Public Function Exist(ToolName As String)
Dim FoundMenu As Variant
Dim FoundItem As Variant
Dim i As Integer

Set FoundMenu = CommandBars.ActiveMenuBar.Controls(3)
Set FoundItem = FoundMenu.Controls(3)

For i = 1 To FoundItem.Controls.Count
If (FoundItem.Controls(i).Caption = ToolName) Then
Exist = True
Exit For
'delete the name
End If
Exist = False
Next i

End Function

Public Function Max_Tool_Bars()
Max_Tool_Bars = MAX_BARS
End Function

Public Function Name(Value As Integer)
Select Case Value
Case 0
Name = "Tool Bar 0"
Case 1
Name = "Tool Bar 1"
Case 2
Name = "Tool Bar 2"
Case 3
Name = ""

Case Else
MsgBox "That Value is not yet supported"
End Select
End Function

'Might be possible to make a generic Create sub routine, but at the moment I
do
' not know how to append a number here to cause Tool_Bar1_Props to be called.
'It would be possible to create a helper sub routine, but still would have to
' add somewhere that Tool_BarX_Props exists. *shrug*
Public Sub Tool_Bar0_Create()
Tool_Bar0_Props
End Sub

Public Sub Tool_Bar1_Create()
Tool_Bar1_Props
End Sub

Public Sub Tool_Bar2_Create()
Tool_Bar2_Props
End Sub

'Generic Sub to Hide a particular toolbar number.
' No testing is done to ensure that TbrNum is within the allowable limits
Public Sub Tool_Bar_Hide(TbrNum As Integer)
On Error GoTo HideErr
Err.Clear
Application.CommandBars(Name(TbrNum)).Visible = False
Exit Sub
HideErr:
All_Bars_Delete

Err.Clear
On Error GoTo 0

End Sub

Private Sub CommonButtons(TbrNum As Integer)

Dim NewItem As Variant

' -----------Description of Button 1
Set NewItem =
Application.CommandBars(Name(TbrNum)).Controls.Add (Type:=msoControlButton)
With NewItem
.BeginGroup = True
.Caption = "Mark the Selected Row(s) for Deletion"
.FaceId = 31
.OnAction = "DeleteMarker.MarkData" '""
.Style = msoButtonIconAndCaption
End With
' -----------End (Description 1)

' -----------Description of Button 1
Set NewItem =
Application.CommandBars(Name(TbrNum)).Controls.Add (Type:=msoControlButton)
With NewItem
.BeginGroup = True
.Caption = "Mark the Selected Row(s) for Deletion"
.FaceId = 32
.OnAction = "DeleteMarker.MarkData" '""
.Style = msoButtonIconAndCaption
End With
' -----------End (Description 1)

' -----------Description of Button 1
Set NewItem =
Application.CommandBars(Name(TbrNum)).Controls.Add (Type:=msoControlButton)
With NewItem
.BeginGroup = True
.Caption = "Mark the Selected Row(s) for Deletion"
.FaceId = 33
.OnAction = "DeleteMarker.MarkData" '""
.Style = msoButtonIconAndCaption
End With
' -----------End (Description 1)

End Sub

Private Sub Tool_Bar0_Props()
Dim NameBar As String
Dim MenuBar As CommandBar
Dim NewItem As Variant
Dim ctrl1 As Variant
Dim Found As Variant
Dim RowNum As Integer

NameBar = ToolBars.Name(0)
On Error GoTo AddErr
Err.Clear

Application.ShowToolTips = True

Set MenuBar = Application.CommandBars.Add(Name:=Name(0),
Position:=msoBarBottom, MenuBar:=False)

With MenuBar
.Protection = msoBarNoCustomize + msoBarNoChangeDock + msoBarNoMove
+ msoBarNoResize
.Visible = True
End With

Call CommonButtons(0)

' -----------Mark Selected Row(s) for Deletion
Set NewItem =
Application.CommandBars(Name(0)).Controls.Add(Type :=msoControlButton)
With NewItem
.BeginGroup = True
.Caption = "Mark the Selected Row(s) for Deletion"
.FaceId = 31
.OnAction = "DeleteMarker.MarkData" '""
.Style = msoButtonCaption
End With
' -----------End Mark Selected Row(s) for Deletion

' -----------Move Button drop down
Set NewItem =
Application.CommandBars(Name(0)).Controls.Add(Type :=msoControlPopup,
Temporary:=True)
With NewItem
.Caption = "&Move"
.BeginGroup = True
.TooltipText = "Move: Move the Selected Row(s) to the Delete Sheet,"
+ _
Chr(13) + Chr(10) + _
"Move the Selected Row(s) to the Keep Sheet."
End With
'Button as a part of the Move drop down
Set ctrl1 = NewItem.Controls.Add(Type:=msoControlButton, Id:=1)
With ctrl1
.DescriptionText = "Move the Selected Row(s) to the Delete Worksheet."
.Caption = "To Delete Sheet"
'.FaceId = 67
.OnAction = "Module5.Move2Del" '""
.Style = msoButtonCaption
.TooltipText = "Move the Selected Row(s) to the Delete Worksheet."
End With
'Button as a part of the Move drop down

Thread Tools	Search this Thread
Show Printable Version	Search this Thread: Advanced Search
Display Modes
Switch to Linear Mode Switch to Hybrid Mode Threaded Mode

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
How do I remove a non-toolbar custom button from a sheet?	AaronInCarolina	Excel Programming	3	September 9th 05 09:13 PM
How to save a custom header/footer on ea. sheet of a workbook?	auditthis	Excel Worksheet Functions	0	August 12th 05 04:49 PM
Copying a workbook with custom toolbar assigned to a macro	Matt W	Excel Discussion (Misc queries)	1	February 4th 05 10:46 PM
custom toolbar buttons are saved where? Excel loads twice bymistake and all my custom toolbar buttons get gone!!!	Kevin Waite	Excel Programming	2	March 3rd 04 03:31 PM
saving toolbar buttons on custom toolbar	Paul James	Excel Programming	12	August 6th 03 08:28 AM