Before I invest a lot of time, I just want to verify that what I want
to do is possible. I have a series of sheets in a workbook. I want to
have some of the tools to be the same with every sheet. But I want
certain tools to appear on the toolbar only when a specific sheet is
selected. Is this doable? I haven't done anything with VBA and toolbars
yet, but have done macros that run when a specific sheet is selected.

Yes it is. I have implemented something similar. I will go ahead and
include my full Toolbar code, but I must preface it by saying that it is not
REALLY clean. I have to handle errors, because I never figured out how to
prevent them, or predetermine that they would exist to prevent them.
Basically to implement my version, when leaving the current sheet, you need
to hide the associated toolbar. When entering the new sheet, you need to
show the associated toolbar. My version will cause the toolbar to move down
and to the right until it hits a lower/right limit then begin showing it up
towards the left, although I have made my version dockable/removable. You
sound like you would want to place the toolbar at the top of the screen and
prevent a user from separating the toolbar from the menu area.

That would "fix" my problem.

Here goes and this is the entire module, so you could insert a new module,
then copy and paste the following into it. I have reused this code for
various applications, so there are several lines commented out. I also have
left some commented lessons learned in here, so that I do not duplicate the
mistake. The end of the module is designated with a very long series of -'s:

Option Explicit

' Written at Norfolk Naval Shipyard (NNSY)
' Code Written by GB
' E-mail:
' Phone #:
' Fax #:
'Version 2.1

Private Const MAX_BARS As Integer = 10

Public Sub All_Bars()
Tool_Bar1_Create
'Dim sheetActivated As Worksheet
'Set sheetActivated = ActiveSheet
Sheet1.Activate
'sheetActivated.Activate
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 = "First Tool Bar"
Case 1
Name = ""
Case Else
MsgBox "That Value is not yet supported"
End Select
End Function

Public Sub Tool_Bar1_Create()
Tool_Bar1_Props
End Sub

Public Sub Tool_Bar1_Hide()
On Error GoTo HideErr
Err.Clear
Application.CommandBars(Name(0)).Visible = False
Exit Sub
HideErr:
All_Bars_Delete

Err.Clear
On Error GoTo 0
End Sub

Private Sub Tool_Bar1_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:=msoBarFloating, MenuBar:=False)

With MenuBar
.Protection = msoBarNoCustomize
.Visible = True
End With

' -----------Update Database Code Button
'Call Sheet1Code.FindNextAddRow(Sheet1)
'RowNum = Sheet1Code.GetLastAddRow

' Set Found = Sheet1.Range(Sheet1.Cells(Variables.GetSheet1RowSt art, _
' Variables.GetSheet1_Name_Col), Sheet1.Cells(RowNum, _
' Variables.GetSheet1_Name_Col)).Find("Freelance", LookIn:=xlValues,
LookAt:=xlWhole)

' Stop Below text DOES NOT WORK, do not try to use it again.
' Set Found = Sheet1.Cells(Variables.GetSheet1RowStart, _
' Variables.GetSheet1_Name_Col).Find("Freelance", LookIn:=xlValues,
Lookat:=xlWhole)

' If Not Found Is Nothing Then
' Set NewItem =
Application.CommandBars(Name(0)).Controls.Add(Type :=msoControlButton)
' With NewItem
' .BeginGroup = True
' .Caption = "Update Code"
' .FaceId = 454
' .OnAction = "CodeUpdate.CopyNewCode" '""
' .Style = msoButtonIconAndCaption
' End With
'End If
' -----------End Update Database Code Button

' -----------Move Selected Row(s) to Delete
' Set NewItem =
Application.CommandBars(Name(0)).Controls.Add(Type :=msoControlButton)
' With NewItem
' .BeginGroup = True
' .Caption = "Move Selected Row(s) to Delete"
' .FaceId = 67
' .OnAction = "ModuleName.Move2Del" '""
' .Style = msoButtonIconAndCaption
' End With
' -----------End Move Selected Row(s) to Delete

' -----------Move Selected Row(s) to Keep
' Set NewItem =
Application.CommandBars(Name(0)).Controls.Add(Type :=msoControlButton)
' With NewItem
' .BeginGroup = True
' .Caption = "Move Selected Row(s) to Keep"
' .FaceId = 270
' .OnAction = "ModuleName.Move2Keep" '""
' .Style = msoButtonIconAndCaption
' End With
' -----------End Move Selected Row(s) to Keep

' -----------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 = msoButtonIconAndCaption
End With
' -----------End Mark Selected Row(s) for Deletion

' -----------Move Button
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

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 = "ModuleName.Move2Del" '""
.TooltipText = "Move the Selected Row(s) to the Delete Worksheet."
End With

Set ctrl1 = NewItem.Controls.Add(Type:=msoControlButton, Id:=1)
With ctrl1
.DescriptionText = "Move the Selected Row(s) to the Keep Worksheet."
.Caption = "To Keep Sheet"
.FaceId = 270
.OnAction = "ModuleName.Move2Keep" '""
.TooltipText = "Move the Selected Row(s) to the Keep Worksheet."
End With

Set NewItem =
Application.CommandBars(Name(0)).Controls.Add(Type :=msoControlButton)
With NewItem
.BeginGroup = True
.Caption = "Setup the Worksheet Data"
.FaceId = 2151
.OnAction = "ModuleName.A_SetupDatabase" '""
.Style = msoButtonIconAndCaption
End With

' Set ctrl1 = NewItem.Controls.Add(Type:=msoControlButton, Id:=1)
' With ctrl1
' .FaceId = 2174
' .Caption = "&Any Single Selected FY"
' .OnAction = "Fiscal.FiscalSortEnter"
' .TooltipText = "Create or modify a FY Spreadsheet."
' End With

' Set ctrl1 = NewItem.Controls.Add(Type:=msoControlButton, Id:=1)
' With ctrl1
' .FaceId = 480
' .Caption = "&Year from Today"
' .OnAction = "Fiscal.CalculateYearSort"
' .TooltipText = "Update the Spreadsheet representing a year from
today."
' End With

' Set ctrl1 = NewItem.Controls.Add(Type:=msoControlButton, Id:=1)
' With ctrl1
' .FaceId = 480
' .Caption = "&Upcoming Payments by Selected Month"
' .OnAction = "MonthReport.Start"
' .TooltipText = "Update the Spreadsheet representing a year from
today."
' End With

' -----------End Calculate Button

' -----------Print Button
' Set newItem =
Application.CommandBars(Name(0)).Controls.Add(Type :=msoControlPopup,
Temporary:=True)
' With newItem
' .Caption = "&Print"
' .BeginGroup = True
' End With

' Set ctrl1 = newItem.Controls.Add(Type:=msoControlButton, Id:=1)
' With ctrl1
' .FaceId = 2174
' .Caption = "&Main Print"
' .OnAction = ""
' End With

' Set ctrl1 = newItem.Controls.Add(Type:=msoControlButton, Id:=1)
' With ctrl1
' .FaceId = 480
' .Caption = "P&rint All"
' .OnAction = ""
' End With

' Set ctrl1 = newItem.Controls.Add(Type:=msoControlButton, Id:=1)
' With ctrl1
' .FaceId = 2144
' .Caption = "Print &This Sheet"
' .OnAction = ""
' End With

' Set NewItem =
Application.CommandBars(Name(0)).Controls.Add(Type :=msoControlButton, Id:=4)
' With NewItem
' .BeginGroup = True
'.Caption = "Enter Data"
'.FaceId = 479
'.OnAction = "ThisWorkbook.ShowNameForm" '""
' .Style = msoButtonIconAndCaption
' End With
'Set ctrl1 = newItem.Controls.Add(Type:=msoControlButton, Id:=4)
' -----------End Print Button

Err.Clear
On Error GoTo 0

Exit Sub

AddErr:
All_Bars_Delete
Resume
'All_Bars
End Sub

Public Sub Tool_Bar1_Show()
On Error GoTo ShowErr
Err.Clear
Application.CommandBars(Name(0)).Visible = True

Err.Clear
On Error GoTo 0
Exit Sub
ShowErr:
All_Bars

Err.Clear
On Error GoTo 0
End Sub

-------------------------------------------------------------------------------------------------------------------------------------



"davegb" wrote:

Before I invest a lot of time, I just want to verify that what I want
to do is possible. I have a series of sheets in a workbook. I want to
have some of the tools to be the same with every sheet. But I want
certain tools to appear on the toolbar only when a specific sheet is
selected. Is this doable? I haven't done anything with VBA and toolbars
yet, but have done macros that run when a specific sheet is selected.

GB wrote:
Yes it is. I have implemented something similar. I will go ahead and
include my full Toolbar code, but I must preface it by saying that it is not
REALLY clean. I have to handle errors, because I never figured out how to
prevent them, or predetermine that they would exist to prevent them.
Basically to implement my version, when leaving the current sheet, you need
to hide the associated toolbar. When entering the new sheet, you need to
show the associated toolbar. My version will cause the toolbar to move down
and to the right until it hits a lower/right limit then begin showing it up
towards the left, although I have made my version dockable/removable. You
sound like you would want to place the toolbar at the top of the screen and
prevent a user from separating the toolbar from the menu area.

That would "fix" my problem.

Here goes and this is the entire module, so you could insert a new module,
then copy and paste the following into it. I have reused this code for
various applications, so there are several lines commented out. I also have
left some commented lessons learned in here, so that I do not duplicate the
mistake. The end of the module is designated with a very long series of -'s:

Option Explicit

' Written at Norfolk Naval Shipyard (NNSY)
' Code Written by GB
' E-mail:
' Phone #:
' Fax #:
'Version 2.1

Private Const MAX_BARS As Integer = 10

Public Sub All_Bars()
Tool_Bar1_Create
'Dim sheetActivated As Worksheet
'Set sheetActivated = ActiveSheet
Sheet1.Activate
'sheetActivated.Activate
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 = "First Tool Bar"
Case 1
Name = ""
Case Else
MsgBox "That Value is not yet supported"
End Select
End Function

Public Sub Tool_Bar1_Create()
Tool_Bar1_Props
End Sub

Public Sub Tool_Bar1_Hide()
On Error GoTo HideErr
Err.Clear
Application.CommandBars(Name(0)).Visible = False
Exit Sub
HideErr:
All_Bars_Delete

Err.Clear
On Error GoTo 0
End Sub

Private Sub Tool_Bar1_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:=msoBarFloating, MenuBar:=False)

With MenuBar
.Protection = msoBarNoCustomize
.Visible = True
End With

' -----------Update Database Code Button
'Call Sheet1Code.FindNextAddRow(Sheet1)
'RowNum = Sheet1Code.GetLastAddRow

' Set Found = Sheet1.Range(Sheet1.Cells(Variables.GetSheet1RowSt art, _
' Variables.GetSheet1_Name_Col), Sheet1.Cells(RowNum, _
' Variables.GetSheet1_Name_Col)).Find("Freelance", LookIn:=xlValues,
LookAt:=xlWhole)

' Stop Below text DOES NOT WORK, do not try to use it again.
' Set Found = Sheet1.Cells(Variables.GetSheet1RowStart, _
' Variables.GetSheet1_Name_Col).Find("Freelance", LookIn:=xlValues,
Lookat:=xlWhole)

' If Not Found Is Nothing Then
' Set NewItem =
Application.CommandBars(Name(0)).Controls.Add(Type :=msoControlButton)
' With NewItem
' .BeginGroup = True
' .Caption = "Update Code"
' .FaceId = 454
' .OnAction = "CodeUpdate.CopyNewCode" '""
' .Style = msoButtonIconAndCaption
' End With
'End If
' -----------End Update Database Code Button

' -----------Move Selected Row(s) to Delete
' Set NewItem =
Application.CommandBars(Name(0)).Controls.Add(Type :=msoControlButton)
' With NewItem
' .BeginGroup = True
' .Caption = "Move Selected Row(s) to Delete"
' .FaceId = 67
' .OnAction = "ModuleName.Move2Del" '""
' .Style = msoButtonIconAndCaption
' End With
' -----------End Move Selected Row(s) to Delete

' -----------Move Selected Row(s) to Keep
' Set NewItem =
Application.CommandBars(Name(0)).Controls.Add(Type :=msoControlButton)
' With NewItem
' .BeginGroup = True
' .Caption = "Move Selected Row(s) to Keep"
' .FaceId = 270
' .OnAction = "ModuleName.Move2Keep" '""
' .Style = msoButtonIconAndCaption
' End With
' -----------End Move Selected Row(s) to Keep

' -----------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 = msoButtonIconAndCaption
End With
' -----------End Mark Selected Row(s) for Deletion

' -----------Move Button
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

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 = "ModuleName.Move2Del" '""
.TooltipText = "Move the Selected Row(s) to the Delete Worksheet."
End With

Set ctrl1 = NewItem.Controls.Add(Type:=msoControlButton, Id:=1)
With ctrl1
.DescriptionText = "Move the Selected Row(s) to the Keep Worksheet."
.Caption = "To Keep Sheet"
.FaceId = 270
.OnAction = "ModuleName.Move2Keep" '""
.TooltipText = "Move the Selected Row(s) to the Keep Worksheet."
End With

Set NewItem =
Application.CommandBars(Name(0)).Controls.Add(Type :=msoControlButton)
With NewItem
.BeginGroup = True
.Caption = "Setup the Worksheet Data"
.FaceId = 2151
.OnAction = "ModuleName.A_SetupDatabase" '""
.Style = msoButtonIconAndCaption
End With

' Set ctrl1 = NewItem.Controls.Add(Type:=msoControlButton, Id:=1)
' With ctrl1
' .FaceId = 2174
' .Caption = "&Any Single Selected FY"
' .OnAction = "Fiscal.FiscalSortEnter"
' .TooltipText = "Create or modify a FY Spreadsheet."
' End With

' Set ctrl1 = NewItem.Controls.Add(Type:=msoControlButton, Id:=1)
' With ctrl1
' .FaceId = 480
' .Caption = "&Year from Today"
' .OnAction = "Fiscal.CalculateYearSort"
' .TooltipText = "Update the Spreadsheet representing a year from
today."
' End With

' Set ctrl1 = NewItem.Controls.Add(Type:=msoControlButton, Id:=1)
' With ctrl1
' .FaceId = 480
' .Caption = "&Upcoming Payments by Selected Month"
' .OnAction = "MonthReport.Start"
' .TooltipText = "Update the Spreadsheet representing a year from
today."
' End With

' -----------End Calculate Button

' -----------Print Button
' Set newItem =
Application.CommandBars(Name(0)).Controls.Add(Type :=msoControlPopup,
Temporary:=True)
' With newItem
' .Caption = "&Print"
' .BeginGroup = True
' End With

' Set ctrl1 = newItem.Controls.Add(Type:=msoControlButton, Id:=1)
' With ctrl1
' .FaceId = 2174
' .Caption = "&Main Print"
' .OnAction = ""
' End With

' Set ctrl1 = newItem.Controls.Add(Type:=msoControlButton, Id:=1)
' With ctrl1
' .FaceId = 480
' .Caption = "P&rint All"
' .OnAction = ""
' End With

' Set ctrl1 = newItem.Controls.Add(Type:=msoControlButton, Id:=1)
' With ctrl1
' .FaceId = 2144
' .Caption = "Print &This Sheet"
' .OnAction = ""
' End With

' Set NewItem =
Application.CommandBars(Name(0)).Controls.Add(Type :=msoControlButton, Id:=4)
' With NewItem
' .BeginGroup = True
'.Caption = "Enter Data"
'.FaceId = 479
'.OnAction = "ThisWorkbook.ShowNameForm" '""
' .Style = msoButtonIconAndCaption
' End With
'Set ctrl1 = newItem.Controls.Add(Type:=msoControlButton, Id:=4)
' -----------End Print Button

Err.Clear
On Error GoTo 0

Exit Sub

AddErr:
All_Bars_Delete
Resume
'All_Bars
End Sub

Public Sub Tool_Bar1_Show()
On Error GoTo ShowErr
Err.Clear
Application.CommandBars(Name(0)).Visible = True

Err.Clear
On Error GoTo 0
Exit Sub
ShowErr:
All_Bars

Err.Clear
On Error GoTo 0
End Sub

-------------------------------------------------------------------------------------------------------------------------------------



"davegb" wrote:

Before I invest a lot of time, I just want to verify that what I want
to do is possible. I have a series of sheets in a workbook. I want to
have some of the tools to be the same with every sheet. But I want
certain tools to appear on the toolbar only when a specific sheet is
selected. Is this doable? I haven't done anything with VBA and toolbars
yet, but have done macros that run when a specific sheet is selected.



Wow! Thanks for your reply.
Looks overwhelming. I'm not sure I can figure this one out. I had no
idea it would be this complicated. There are several kinds of syntax
I've never used before. I think this one's just beyond me at this
point.

Wow! Thanks for your reply.
Looks overwhelming. I'm not sure I can figure this one out. I had no
idea it would be this complicated. There are several kinds of syntax
I've never even used before. I think this one's just beyond me at this
point!

In the end... It's actually quite easy from the code I've written. Anytime I
want to "develop" a new toolbar. I go into two areas:

Function Name():
I change the name of the toolbar that I'm trying to use to something unique,
that I hopefully have never developed before/expect to use at the same time
that I'm using this new toolbar.

And then I go into the appropriate Tool_Bar(Number)_Props:
for example Tool_Bar1_Props.
And I revise the toolbar to what I want. If I want a button in a group,
then I use:
Set NewItem =
Application.CommandBars(Name(0)).Controls.Add(Type :=msoControlButton)
And then I work with the NewItem (Control Button)

And if I want a Drop down menu to work with, then I:
Set NewItem =
Application.CommandBars(Name(0)).Controls.Add(Type :=msoControlPopup,
Temporary:=True)

And then for every button or item I want to add to that drop down, I use the
newItem and set a ctrl1 variable. The help files on commandbars will tell
you about the different Types, and things like Temporary.

The other thing that I have to change depending on what I expect of the
particular button is the .OnAction command. It has to refer to a procedure
that will do what I want.

In the example provided, if you make a module that is named ModuleName
(Instead of Module1 for example) that has say the public sub routine Move2Del
and Select the drop down menu of the newly created Excel menu that appears
and select the one that says move to the delete folder, it will run whatever
you have programmed in Move2Del.

The FaceId's that I have selected correspond to the actions that I desired
and were fairly readily available.

All in all, the hard part is done for you. And if you get the code into VBA
you will see that like a lot of the Tool_Bar1_Props lines are commented out.
But I have done some different things in there that I do not want to lose so
that if I wish to implement them in the future I have them readily available.

Chr(13) + Char(10) just gives a new line of text
A line ending with an underscore is so that I can have "one" line of code
that I can see completly on the screen and on printouts. It tells VBA that
hey, don't stop processing the next line of code as part of the current line.

If you want to Show ToolBar1 (which in this code, I only implemented one)
then you call Tool_Bar1_Show. The error handling will ensure that it will
appear.

One thing that I forgot to mention was that when the workbook loses focus,
the toolbars should be "put away" or deleted. And then when the workbook
regains focus, the appropriate toolbar(s) should be shown again.

"davegb" wrote:

Wow! Thanks for your reply.
Looks overwhelming. I'm not sure I can figure this one out. I had no
idea it would be this complicated. There are several kinds of syntax
I've never even used before. I think this one's just beyond me at this
point!

GB wrote:
In the end... It's actually quite easy from the code I've written. Anytime I
want to "develop" a new toolbar. I go into two areas:

Function Name():
I change the name of the toolbar that I'm trying to use to something unique,
that I hopefully have never developed before/expect to use at the same time
that I'm using this new toolbar.

Ok, I'm going to give this a try. I'll start with a few basic questions
trying to clarify how the macro works. If your patience holds up, I'll
ask more about specific code.
I put your code in a module and rearranged a bit because going from a
module to here to a module, there were lots of lines of red which were
mostly continuations from the previous line.
From your description above, I'm guessing that the code starts at
"Function Name". Is this called by a particular worksheet being
activated? I don't see it being called anywhere else in the code. If
not, then why is it a function instead of just a subroutine?

Looking at Function Name, I'm not clear on what the Select Case
statement is based. Where is "Value" defined? I know it's a zero or a
1, but I can't find where it comes from.
If it's a zero, the toolbar gets named "First Tool Bar", if not, it
doesn't get named.
Finally, since it ends after the Select Case command is executed, how
does the rest of the code get run? Is there more code back at the sheet
itself that calls some other code after Function Name is run?


And then I go into the appropriate Tool_Bar(Number)_Props:
for example Tool_Bar1_Props.
And I revise the toolbar to what I want. If I want a button in a group,
then I use:
Set NewItem =
Application.CommandBars(Name(0)).Controls.Add(Type :=msoControlButton)
And then I work with the NewItem (Control Button)

And if I want a Drop down menu to work with, then I:
Set NewItem =
Application.CommandBars(Name(0)).Controls.Add(Type :=msoControlPopup,
Temporary:=True)

And then for every button or item I want to add to that drop down, I use the
newItem and set a ctrl1 variable. The help files on commandbars will tell
you about the different Types, and things like Temporary.

The other thing that I have to change depending on what I expect of the
particular button is the .OnAction command. It has to refer to a procedure
that will do what I want.

In the example provided, if you make a module that is named ModuleName
(Instead of Module1 for example) that has say the public sub routine Move2Del
and Select the drop down menu of the newly created Excel menu that appears
and select the one that says move to the delete folder, it will run whatever
you have programmed in Move2Del.

The FaceId's that I have selected correspond to the actions that I desired
and were fairly readily available.

All in all, the hard part is done for you. And if you get the code into VBA
you will see that like a lot of the Tool_Bar1_Props lines are commented out.
But I have done some different things in there that I do not want to lose so
that if I wish to implement them in the future I have them readily available.

Chr(13) + Char(10) just gives a new line of text
A line ending with an underscore is so that I can have "one" line of code
that I can see completly on the screen and on printouts. It tells VBA that
hey, don't stop processing the next line of code as part of the current line.

If you want to Show ToolBar1 (which in this code, I only implemented one)
then you call Tool_Bar1_Show. The error handling will ensure that it will
appear.

One thing that I forgot to mention was that when the workbook loses focus,
the toolbars should be "put away" or deleted. And then when the workbook
regains focus, the appropriate toolbar(s) should be shown again.

"davegb" wrote:

Wow! Thanks for your reply.
Looks overwhelming. I'm not sure I can figure this one out. I had no
idea it would be this complicated. There are several kinds of syntax
I've never even used before. I think this one's just beyond me at this
point!

Okay, item by item....

Function Name

This is a Function that is called Name (Not sure of your level of
experience, so want to start with basics.)

It is a public function, so that other modules can get the name of the
toolbar that is set to value 0, 1, 2, etc..

Value, is the toolbar number that I have designated to a particular toolbar.

In my case, I really just have 1 toolbar implemented, so the Select Case
Value isn't necessary. However, I program for expandability. I saw that I
might need additional toolbars in a single document, and wanted to have that
ability to expand.
So, if I want to get the name of Toolbar number 2 I call Name(2) and the
select case function gives me the name back of toolbar 2.

For the application included, look for where Name(0) is used... This is one
way to back track and see how the Name() function is used and get an idea of
it's "importance/impact."

As far as first run code.... The function called Name may be the first in
the list, but it is not the meat of the program. For the toolbars to be
shown, there are two ways to make them appear. One is to show all toolbars,
the other is to show a particular toolbar. To show toolbar1, you first have
to create it... If you don't create it first, then all toolbars will be
shown (look at the error statement section that gets called if it can not
verify the existence of the toolbar). On retrospect, I probably should have
the toolbar1 show routine call toolbar1 create, instead of allbars..
(Written when I was about finished with this: Actually the reason I used the
Allbars option, was to ensure that if one toolbar was not already created,
perhaps all of the others have not been created, and therefore to blanketly
create all toolbars to ensure/force them to be "available" for use.
Therefore, no the Toolbar1_Show routine should not be revised.)

Again, though I have yet to actually implement multiple toolbars, but all of
the underlying structure is there. I have been able to get a toolbar to
appear on a sheet, and disappear when I leave the sheet, also when I make the
workbook active with the applicable sheet present, it opens the toolbar, and
when the workbook loses focus, the toolbar disappears.

As for code on other pages. Yes, there is code depending on what you want
to happen that can/should be put on other pages. For example, if you want
something to happen when changing sheets, the Code for that particular
worksheet should include an activate/deactivate section: (I.e.,

Private Sub Worksheet_Activate()
Toolbars.Toolbar1_Show
End Sub

Private Sub Worksheet_DeActivate()
Toolbars.Toolbar1_Hide
End Sub

And then something similar with the Workbook ThisWorkbook "sheet". If you
have not seen the list of Microsoft Excel Objects, the chose View-Project
Explorer or something similar.

I'm still with you. You with me? :)

"davegb" wrote:


GB wrote:
In the end... It's actually quite easy from the code I've written. Anytime I
want to "develop" a new toolbar. I go into two areas:

Function Name():
I change the name of the toolbar that I'm trying to use to something unique,
that I hopefully have never developed before/expect to use at the same time
that I'm using this new toolbar.

Ok, I'm going to give this a try. I'll start with a few basic questions
trying to clarify how the macro works. If your patience holds up, I'll
ask more about specific code.
I put your code in a module and rearranged a bit because going from a
module to here to a module, there were lots of lines of red which were
mostly continuations from the previous line.
From your description above, I'm guessing that the code starts at
"Function Name". Is this called by a particular worksheet being
activated? I don't see it being called anywhere else in the code. If
not, then why is it a function instead of just a subroutine?

Looking at Function Name, I'm not clear on what the Select Case
statement is based. Where is "Value" defined? I know it's a zero or a
1, but I can't find where it comes from.
If it's a zero, the toolbar gets named "First Tool Bar", if not, it
doesn't get named.
Finally, since it ends after the Select Case command is executed, how
does the rest of the code get run? Is there more code back at the sheet
itself that calls some other code after Function Name is run?


And then I go into the appropriate Tool_Bar(Number)_Props:
for example Tool_Bar1_Props.
And I revise the toolbar to what I want. If I want a button in a group,
then I use:
Set NewItem =
Application.CommandBars(Name(0)).Controls.Add(Type :=msoControlButton)
And then I work with the NewItem (Control Button)

And if I want a Drop down menu to work with, then I:
Set NewItem =
Application.CommandBars(Name(0)).Controls.Add(Type :=msoControlPopup,
Temporary:=True)

And then for every button or item I want to add to that drop down, I use the
newItem and set a ctrl1 variable. The help files on commandbars will tell
you about the different Types, and things like Temporary.

The other thing that I have to change depending on what I expect of the
particular button is the .OnAction command. It has to refer to a procedure
that will do what I want.

In the example provided, if you make a module that is named ModuleName
(Instead of Module1 for example) that has say the public sub routine Move2Del
and Select the drop down menu of the newly created Excel menu that appears
and select the one that says move to the delete folder, it will run whatever
you have programmed in Move2Del.

The FaceId's that I have selected correspond to the actions that I desired
and were fairly readily available.

All in all, the hard part is done for you. And if you get the code into VBA
you will see that like a lot of the Tool_Bar1_Props lines are commented out.
But I have done some different things in there that I do not want to lose so
that if I wish to implement them in the future I have them readily available.

Chr(13) + Char(10) just gives a new line of text
A line ending with an underscore is so that I can have "one" line of code
that I can see completly on the screen and on printouts. It tells VBA that
hey, don't stop processing the next line of code as part of the current line.

If you want to Show ToolBar1 (which in this code, I only implemented one)
then you call Tool_Bar1_Show. The error handling will ensure that it will
appear.

One thing that I forgot to mention was that when the workbook loses focus,
the toolbars should be "put away" or deleted. And then when the workbook
regains focus, the appropriate toolbar(s) should be shown again.

"davegb" wrote:

Wow! Thanks for your reply.
Looks overwhelming. I'm not sure I can figure this one out. I had no
idea it would be this complicated. There are several kinds of syntax
I've never even used before. I think this one's just beyond me at this
point!

I didn't discuss it, but yes, I have also run into the problem of lines being
red because of the way the copy/paste works in here. But you are correct, if
it is red, either put a space and an underscore at the end of the previous
line, or move the current line to line up with the end of the previous line.
Of course, the space underscore will not work if it is captured in a quoted
line. Like:

Msgbox("This is an example of a _
broken line that will not work right. :)")

Where it should say
Msgbox("This is an example of a broken line that will not work right. :)")
'<-- although now the text statement is incorrect because it is no longer a
broken line. :) But you get the gest.


"davegb" wrote:


GB wrote:
In the end... It's actually quite easy from the code I've written. Anytime I
want to "develop" a new toolbar. I go into two areas:

Function Name():
I change the name of the toolbar that I'm trying to use to something unique,
that I hopefully have never developed before/expect to use at the same time
that I'm using this new toolbar.

Ok, I'm going to give this a try. I'll start with a few basic questions
trying to clarify how the macro works. If your patience holds up, I'll
ask more about specific code.
I put your code in a module and rearranged a bit because going from a
module to here to a module, there were lots of lines of red which were
mostly continuations from the previous line.
From your description above, I'm guessing that the code starts at
"Function Name". Is this called by a particular worksheet being
activated? I don't see it being called anywhere else in the code. If
not, then why is it a function instead of just a subroutine?

Looking at Function Name, I'm not clear on what the Select Case
statement is based. Where is "Value" defined? I know it's a zero or a
1, but I can't find where it comes from.
If it's a zero, the toolbar gets named "First Tool Bar", if not, it
doesn't get named.
Finally, since it ends after the Select Case command is executed, how
does the rest of the code get run? Is there more code back at the sheet
itself that calls some other code after Function Name is run?


And then I go into the appropriate Tool_Bar(Number)_Props:
for example Tool_Bar1_Props.
And I revise the toolbar to what I want. If I want a button in a group,
then I use:
Set NewItem =
Application.CommandBars(Name(0)).Controls.Add(Type :=msoControlButton)
And then I work with the NewItem (Control Button)

And if I want a Drop down menu to work with, then I:
Set NewItem =
Application.CommandBars(Name(0)).Controls.Add(Type :=msoControlPopup,
Temporary:=True)

And then for every button or item I want to add to that drop down, I use the
newItem and set a ctrl1 variable. The help files on commandbars will tell
you about the different Types, and things like Temporary.

The other thing that I have to change depending on what I expect of the
particular button is the .OnAction command. It has to refer to a procedure
that will do what I want.

In the example provided, if you make a module that is named ModuleName
(Instead of Module1 for example) that has say the public sub routine Move2Del
and Select the drop down menu of the newly created Excel menu that appears
and select the one that says move to the delete folder, it will run whatever
you have programmed in Move2Del.

The FaceId's that I have selected correspond to the actions that I desired
and were fairly readily available.

All in all, the hard part is done for you. And if you get the code into VBA
you will see that like a lot of the Tool_Bar1_Props lines are commented out.
But I have done some different things in there that I do not want to lose so
that if I wish to implement them in the future I have them readily available.

Chr(13) + Char(10) just gives a new line of text
A line ending with an underscore is so that I can have "one" line of code
that I can see completly on the screen and on printouts. It tells VBA that
hey, don't stop processing the next line of code as part of the current line.

If you want to Show ToolBar1 (which in this code, I only implemented one)
then you call Tool_Bar1_Show. The error handling will ensure that it will
appear.

One thing that I forgot to mention was that when the workbook loses focus,
the toolbars should be "put away" or deleted. And then when the workbook
regains focus, the appropriate toolbar(s) should be shown again.

"davegb" wrote:

Wow! Thanks for your reply.
Looks overwhelming. I'm not sure I can figure this one out. I had no
idea it would be this complicated. There are several kinds of syntax
I've never even used before. I think this one's just beyond me at this
point!

If anyone has ideas of how to make my toolbar module better/less prone to
having to use the error catching that I do, please assist. I wrote this
function a little over 3 years ago, and still use it without incident, but
doesn't look pretty.



"GB" wrote:

Yes it is. I have implemented something similar. I will go ahead and
include my full Toolbar code, but I must preface it by saying that it is not
REALLY clean. I have to handle errors, because I never figured out how to
prevent them, or predetermine that they would exist to prevent them.
Basically to implement my version, when leaving the current sheet, you need
to hide the associated toolbar. When entering the new sheet, you need to
show the associated toolbar. My version will cause the toolbar to move down
and to the right until it hits a lower/right limit then begin showing it up
towards the left, although I have made my version dockable/removable. You
sound like you would want to place the toolbar at the top of the screen and
prevent a user from separating the toolbar from the menu area.

That would "fix" my problem.

Here goes and this is the entire module, so you could insert a new module,
then copy and paste the following into it. I have reused this code for
various applications, so there are several lines commented out. I also have
left some commented lessons learned in here, so that I do not duplicate the
mistake. The end of the module is designated with a very long series of -'s:

Option Explicit

' Written at Norfolk Naval Shipyard (NNSY)
' Code Written by GB
' E-mail:
' Phone #:
' Fax #:
'Version 2.1

Private Const MAX_BARS As Integer = 10

Public Sub All_Bars()
Tool_Bar1_Create
'Dim sheetActivated As Worksheet
'Set sheetActivated = ActiveSheet
Sheet1.Activate
'sheetActivated.Activate
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 = "First Tool Bar"
Case 1
Name = ""
Case Else
MsgBox "That Value is not yet supported"
End Select
End Function

Public Sub Tool_Bar1_Create()
Tool_Bar1_Props
End Sub

Public Sub Tool_Bar1_Hide()
On Error GoTo HideErr
Err.Clear
Application.CommandBars(Name(0)).Visible = False
Exit Sub
HideErr:
All_Bars_Delete

Err.Clear
On Error GoTo 0
End Sub

Private Sub Tool_Bar1_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:=msoBarFloating, MenuBar:=False)

With MenuBar
.Protection = msoBarNoCustomize
.Visible = True
End With

' -----------Update Database Code Button
'Call Sheet1Code.FindNextAddRow(Sheet1)
'RowNum = Sheet1Code.GetLastAddRow

' Set Found = Sheet1.Range(Sheet1.Cells(Variables.GetSheet1RowSt art, _
' Variables.GetSheet1_Name_Col), Sheet1.Cells(RowNum, _
' Variables.GetSheet1_Name_Col)).Find("Freelance", LookIn:=xlValues,
LookAt:=xlWhole)

' Stop Below text DOES NOT WORK, do not try to use it again.
' Set Found = Sheet1.Cells(Variables.GetSheet1RowStart, _
' Variables.GetSheet1_Name_Col).Find("Freelance", LookIn:=xlValues,
Lookat:=xlWhole)

' If Not Found Is Nothing Then
' Set NewItem =
Application.CommandBars(Name(0)).Controls.Add(Type :=msoControlButton)
' With NewItem
' .BeginGroup = True
' .Caption = "Update Code"
' .FaceId = 454
' .OnAction = "CodeUpdate.CopyNewCode" '""
' .Style = msoButtonIconAndCaption
' End With
'End If
' -----------End Update Database Code Button

' -----------Move Selected Row(s) to Delete
' Set NewItem =
Application.CommandBars(Name(0)).Controls.Add(Type :=msoControlButton)
' With NewItem
' .BeginGroup = True
' .Caption = "Move Selected Row(s) to Delete"
' .FaceId = 67
' .OnAction = "ModuleName.Move2Del" '""
' .Style = msoButtonIconAndCaption
' End With
' -----------End Move Selected Row(s) to Delete

' -----------Move Selected Row(s) to Keep
' Set NewItem =
Application.CommandBars(Name(0)).Controls.Add(Type :=msoControlButton)
' With NewItem
' .BeginGroup = True
' .Caption = "Move Selected Row(s) to Keep"
' .FaceId = 270
' .OnAction = "ModuleName.Move2Keep" '""
' .Style = msoButtonIconAndCaption
' End With
' -----------End Move Selected Row(s) to Keep

' -----------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 = msoButtonIconAndCaption
End With
' -----------End Mark Selected Row(s) for Deletion

' -----------Move Button
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

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 = "ModuleName.Move2Del" '""
.TooltipText = "Move the Selected Row(s) to the Delete Worksheet."
End With

Set ctrl1 = NewItem.Controls.Add(Type:=msoControlButton, Id:=1)
With ctrl1
.DescriptionText = "Move the Selected Row(s) to the Keep Worksheet."
.Caption = "To Keep Sheet"
.FaceId = 270
.OnAction = "ModuleName.Move2Keep" '""
.TooltipText = "Move the Selected Row(s) to the Keep Worksheet."
End With

Set NewItem =
Application.CommandBars(Name(0)).Controls.Add(Type :=msoControlButton)
With NewItem
.BeginGroup = True
.Caption = "Setup the Worksheet Data"
.FaceId = 2151
.OnAction = "ModuleName.A_SetupDatabase" '""
.Style = msoButtonIconAndCaption
End With

' Set ctrl1 = NewItem.Controls.Add(Type:=msoControlButton, Id:=1)
' With ctrl1
' .FaceId = 2174
' .Caption = "&Any Single Selected FY"
' .OnAction = "Fiscal.FiscalSortEnter"
' .TooltipText = "Create or modify a FY Spreadsheet."
' End With

' Set ctrl1 = NewItem.Controls.Add(Type:=msoControlButton, Id:=1)
' With ctrl1
' .FaceId = 480
' .Caption = "&Year from Today"
' .OnAction = "Fiscal.CalculateYearSort"
' .TooltipText = "Update the Spreadsheet representing a year from
today."
' End With

' Set ctrl1 = NewItem.Controls.Add(Type:=msoControlButton, Id:=1)
' With ctrl1
' .FaceId = 480
' .Caption = "&Upcoming Payments by Selected Month"
' .OnAction = "MonthReport.Start"
' .TooltipText = "Update the Spreadsheet representing a year from
today."
' End With

' -----------End Calculate Button

' -----------Print Button
' Set newItem =
Application.CommandBars(Name(0)).Controls.Add(Type :=msoControlPopup,
Temporary:=True)
' With newItem
' .Caption = "&Print"
' .BeginGroup = True
' End With

' Set ctrl1 = newItem.Controls.Add(Type:=msoControlButton, Id:=1)
' With ctrl1
' .FaceId = 2174
' .Caption = "&Main Print"
' .OnAction = ""
' End With

' Set ctrl1 = newItem.Controls.Add(Type:=msoControlButton, Id:=1)
' With ctrl1
' .FaceId = 480

So, what did you decide. Dropping this aspect of the project? I was going
to see if I could implement what we have talked about. I think it would be a
matter of a few minutes. I'll post the code when I'm done.

"davegb" wrote:

Before I invest a lot of time, I just want to verify that what I want
to do is possible. I have a series of sheets in a workbook. I want to
have some of the tools to be the same with every sheet. But I want
certain tools to appear on the toolbar only when a specific sheet is
selected. Is this doable? I haven't done anything with VBA and toolbars
yet, but have done macros that run when a specific sheet is selected.

GB wrote:
So, what did you decide. Dropping this aspect of the project?

See my questions above. Haven't dropped it, still struggling.

I was going
to see if I could implement what we have talked about. I think it would be a
matter of a few minutes. I'll post the code when I'm done.

"davegb" wrote:

Before I invest a lot of time, I just want to verify that what I want
to do is possible. I have a series of sheets in a workbook. I want to
have some of the tools to be the same with every sheet. But I want
certain tools to appear on the toolbar only when a specific sheet is
selected. Is this doable? I haven't done anything with VBA and toolbars
yet, but have done macros that run when a specific sheet is selected.

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
Set ctrl1 = NewItem.Controls.Add(Type:=msoControlButton, Id:=1)
With ctrl1
.DescriptionText = "Move the Selected Row(s) to the Keep Worksheet."
.Caption = "To Keep Sheet"
'.FaceId = 270
.OnAction = "Module5.Move2Keep" '""
.Style = msoButtonCaption
.TooltipText = "Move the Selected Row(s) to the Keep Worksheet."
End With
'------------ End of Move Drop down options

'------------ Start of a New button
Set NewItem =
Application.CommandBars(Name(0)).Controls.Add(Type :=msoControlButton)
With NewItem
.BeginGroup = True
.Caption = "Setup the Database"
'.FaceId = 2151
.OnAction = "Module4.A_SetupDatabase" '""
.Style = msoButtonCaption
End With
'------------ End of the Setup Database Button.


' -----------Print Button
' Set newItem =
Application.CommandBars(Name(0)).Controls.Add(Type :=msoControlPopup,
Temporary:=True)
' With newItem
' .Caption = "&Print"
' .BeginGroup = True
' End With


' Set ctrl1 = newItem.Controls.Add(Type:=msoControlButton, Id:=1)
' With ctrl1
' .FaceId = 480
' .Caption = "P&rint All"
' .OnAction = ""
' End With

' Set ctrl1 = newItem.Controls.Add(Type:=msoControlButton, Id:=1)
' With ctrl1
' .FaceId = 2144
' .Caption = "Print &This Sheet"
' .OnAction = ""
' End With

' Set NewItem =
Application.CommandBars(Name(0)).Controls.Add(Type :=msoControlButton, Id:=4)
' With NewItem
' .BeginGroup = True
'.Caption = "Enter Data"
'.FaceId = 479
'.OnAction = "ThisWorkbook.ShowNameForm" '""
' .Style = msobuttoncaption
' End With
'Set ctrl1 = newItem.Controls.Add(Type:=msoControlButton, Id:=4)
' -----------End Print Button

Err.Clear
On Error GoTo 0

Exit Sub

AddErr:
All_Bars_Delete
Resume
End Sub


Private Sub Tool_Bar1_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(1)
On Error GoTo AddErr
Err.Clear

Application.ShowToolTips = True

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

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

Call CommonButtons(1)

' -----------Mark Selected Row(s) for Deletion
Set NewItem =
Application.CommandBars(Name(1)).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(1)).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" '""
.TooltipText = "Move the Selected Row(s) to the Delete Worksheet."
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 Keep Worksheet."
.Caption = "To Keep Sheet"
.FaceId = 270
.OnAction = "Module5.Move2Keep" '""
.TooltipText = "Move the Selected Row(s) to the Keep Worksheet."
End With
'------------ End of Move Drop down options

'------------ Start of a New button
Set NewItem =
Application.CommandBars(Name(1)).Controls.Add(Type :=msoControlButton)
With NewItem
.BeginGroup = True
.Caption = "Setup the Database"
.FaceId = 2151
.OnAction = "Module4.A_SetupDatabase" '""
.Style = msoButtonCaption
End With
'------------ End of the Setup Database Button.


' -----------Print Button
' Set newItem =
Application.CommandBars(Name(1)).Controls.Add(Type :=msoControlPopup,
Temporary:=True)
' With newItem
' .Caption = "&Print"
' .BeginGroup = True
' End With


' Set ctrl1 = newItem.Controls.Add(Type:=msoControlButton, Id:=1)
' With ctrl1
' .FaceId = 480
' .Caption = "P&rint All"
' .OnAction = ""
' End With

' Set ctrl1 = newItem.Controls.Add(Type:=msoControlButton, Id:=1)
' With ctrl1
' .FaceId = 2144
' .Caption = "Print &This Sheet"
' .OnAction = ""
' End With

' Set NewItem =
Application.CommandBars(Name(1)).Controls.Add(Type :=msoControlButton, Id:=4)
' With NewItem
' .BeginGroup = True
'.Caption = "Enter Data"
'.FaceId = 479
'.OnAction = "ThisWorkbook.ShowNameForm" '""
' .Style = msobuttoncaption
' End With
'Set ctrl1 = newItem.Controls.Add(Type:=msoControlButton, Id:=4)
' -----------End Print Button

Err.Clear
On Error GoTo 0

Exit Sub

AddErr:
All_Bars_Delete
Resume
End Sub


Private Sub Tool_Bar2_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(2)
On Error GoTo AddErr
Err.Clear

Application.ShowToolTips = True

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

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

Call CommonButtons(2)

' -----------Mark Selected Row(s) for Deletion
Set NewItem =
Application.CommandBars(Name(2)).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(2)).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" '""
.TooltipText = "Move the Selected Row(s) to the Delete Worksheet."
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 Keep Worksheet."
.Caption = "To Keep Sheet"
'.FaceId = 270
.OnAction = "Module5.Move2Keep" '""
.TooltipText = "Move the Selected Row(s) to the Keep Worksheet."
End With
'------------ End of Move Drop down options

'------------ Start of a New button
Set NewItem =
Application.CommandBars(Name(2)).Controls.Add(Type :=msoControlButton)
With NewItem
.BeginGroup = True
.Caption = "Setup the Database"
.FaceId = 2151
.OnAction = "Module4.A_SetupDatabase" '""
.Style = msoButtonCaption
End With
'------------ End of the Setup Database Button.


' -----------Print Button
' Set newItem =
Application.CommandBars(Name(2)).Controls.Add(Type :=msoControlPopup,
Temporary:=True)
' With newItem
' .Caption = "&Print"
' .BeginGroup = True
' End With


' Set ctrl1 = newItem.Controls.Add(Type:=msoControlButton, Id:=1)
' With ctrl1
' .FaceId = 480
' .Caption = "P&rint All"
' .OnAction = ""
' End With

' Set ctrl1 = newItem.Controls.Add(Type:=msoControlButton, Id:=1)
' With ctrl1
' .FaceId = 2144
' .Caption = "Print &This Sheet"
' .OnAction = ""
' End With

' Set NewItem =
Application.CommandBars(Name(2)).Controls.Add(Type :=msoControlButton, Id:=4)
' With NewItem
' .BeginGroup = True
'.Caption = "Enter Data"
'.FaceId = 479
'.OnAction = "ThisWorkbook.ShowNameForm" '""
' .Style = msobuttoncaption
' End With
'Set ctrl1 = newItem.Controls.Add(Type:=msoControlButton, Id:=4)
' -----------End Print Button

Err.Clear
On Error GoTo 0

Exit Sub

AddErr:
All_Bars_Delete
Resume
End Sub

'Made a generic toolbar show routine that only requires the number of the
toolbar
' that you want to show.
Public Sub Tool_Bar_Show(TbrNum As Integer)
On Error GoTo ShowErr
Err.Clear
Application.CommandBars(Name(TbrNum)).Visible = True

Err.Clear
On Error GoTo 0
Exit Sub
ShowErr:
All_Bars

Err.Clear
On Error GoTo 0

End Sub


'End of Toolbars module code here

'Start of Sheet1 code

Option Explicit

Private Sub Worksheet_Activate()
ToolBars.All_Bars_Hide
ToolBars.Tool_Bar_Show (0)
End Sub

Private Sub Worksheet_Deactivate()
ToolBars.All_Bars_Hide
End Sub

'End of Sheet1 code


Here is my ThisWorkbook code for this:

'Start of ThisWorkbook code

Option Explicit

Private Sub Workbook_BeforeClose(Cancel As Boolean)
ToolBars.All_Bars_Delete
End Sub

Private Sub Workbook_Open()
ToolBars.All_Bars
End Sub

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

Private Sub Workbook_WindowDeactivate(ByVal Wn As Window)
ToolBars.All_Bars_Hide
End Sub



'End of ThisWorkbook code


"davegb" wrote:

Before I invest a lot of time, I just want to verify that what I want
to do is possible. I have a series of sheets in a workbook. I want to
have some of the tools to be the same with every sheet. But I want
certain tools to appear on the toolbar only when a specific sheet is
selected. Is this doable? I haven't done anything with VBA and toolbars
yet, but have done macros that run when a specific sheet is selected.

Something that I did not explain to you or in my code. The MAX_BARS variable
is determined by the restrictions of Excel. I read somewhere that the user
was only able to create a maximum of 10 toolbars, and so I tried to implement
that here.

I realize you said you only needed like 7 or 9, I can't remember, but if
greater than 10 were necessary, the thought that I have is before, attempting
to create the 11th toolbar, one of the other toolbars is deleted (not hidden,
but actually deleted.) If that deleted toolbar is later needed, the code
should properly handle the recreation. But would have to have some way to
track how many user toolbars have been created already so that creation of
the next toolbar doesn't totally botch. :)

So, obviously not perfect code, but works up to the current limits of excel.


"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
Set ctrl1 = NewItem.Controls.Add(Type:=msoControlButton, Id:=1)
With ctrl1
.DescriptionText = "Move the Selected Row(s) to the Keep Worksheet."
.Caption = "To Keep Sheet"
'.FaceId = 270
.OnAction = "Module5.Move2Keep" '""
.Style = msoButtonCaption
.TooltipText = "Move the Selected Row(s) to the Keep Worksheet."
End With
'------------ End of Move Drop down options

'------------ Start of a New button
Set NewItem =
Application.CommandBars(Name(0)).Controls.Add(Type :=msoControlButton)
With NewItem
.BeginGroup = True
.Caption = "Setup the Database"
'.FaceId = 2151
.OnAction = "Module4.A_SetupDatabase" '""
.Style = msoButtonCaption
End With
'------------ End of the Setup Database Button.


' -----------Print Button
' Set newItem =
Application.CommandBars(Name(0)).Controls.Add(Type :=msoControlPopup,
Temporary:=True)
' With newItem
' .Caption = "&Print"
' .BeginGroup = True
' End With


' Set ctrl1 = newItem.Controls.Add(Type:=msoControlButton, Id:=1)
' With ctrl1
' .FaceId = 480

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
Set ctrl1 = NewItem.Controls.Add(Type:=msoControlButton, Id:=1)
With ctrl1
.DescriptionText = "Move the Selected Row(s) to the Keep Worksheet."
.Caption = "To Keep Sheet"
'.FaceId = 270
.OnAction = "Module5.Move2Keep" '""
.Style = msoButtonCaption
.TooltipText = "Move the Selected Row(s) to the Keep Worksheet."
End With
'------------ End of Move Drop down options

'------------ Start of a New button
Set NewItem =
Application.CommandBars(Name(0)).Controls.Add(Type :=msoControlButton)
With NewItem
.BeginGroup = True
.Caption = "Setup the Database"
'.FaceId = 2151
.OnAction = "Module4.A_SetupDatabase" '""
.Style = msoButtonCaption
End With
'------------ End of the Setup Database Button.


' -----------Print Button
' Set newItem =
Application.CommandBars(Name(0)).Controls.Add(Type :=msoControlPopup,
Temporary:=True)
' With newItem
' .Caption = "&Print"
' .BeginGroup = True
' End With


' Set ctrl1 = newItem.Controls.Add(Type:=msoControlButton, Id:=1)
' With ctrl1
' .FaceId = 480

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