? for Ron de Bruin -- NavToolBar

[Ray]

Hi Ron -

I've got an add-in (built for XL2003) that has been extremely useful
to me and now that my company has migrated to XL2007, I find that I
really miss it .... this code was originally built by Dave Peterson,
but he referred me to you (due to your XL2007 knowledge). I hope you
can help ...

The code basically builds a small drop-down 'menu' by which I'm able
to easily navigate through all of the sheets in the active workbook
(using 'refresh' to update for a new book). I should note that the
code DOES WORK in XL2007 ... however, instead of using a drop-down
that's anchored to the bottom of my window, I have to click on Add-Ins
(in the Ribbon) first. It's just one extra step, but over the past 2
weeks, I've found it to be tiresome.

So, here's my question - can this code be modified to do the same
thing (anchored to bottom of window) in XL2007 and if so, how? I know
I can use the UI Editor to change the Ribbon itself, but I don't have
time to figure this part out.

Thanks in Advance,
Ray


Here's the code:
Sub Autpen()
'code written by Dave Peterson 2005-12-21
'creates a toolbar with list of sheets in active workbook

Dim cb As CommandBar
Dim ctrl As CommandBarControl

On Error Resume Next
Application.CommandBars("MyNavigator").Delete
On Error GoTo 0

Set cb = Application.CommandBars.Add(Name:="myNavigator",
Position:=msoBarBottom, temporary:=True)
With cb
.Visible = True
Set ctrl = .Controls.Add(Type:=msoControlButton,
temporary:=True)
With ctrl
.Style = msoButtonCaption
.Caption = "Refresh Worksheet List"
.OnAction = ThisWorkbook.Name & "!refreshthesheets"
End With

Set ctrl = .Controls.Add(Type:=msoControlComboBox,
temporary:=True)
With ctrl
.Width = 300
.AddItem "Click Refresh First"
.OnAction = ThisWorkbook.Name & "!changethesheet"
.Tag = "__wksnames__"
End With
End With

End Sub

 

[Ron de Bruin]

Hi Ray

You have a few options

Add it to the QAT
Add it to this menu in the QAT ( http://www.rondebruin.nl/qat.htm )
Add a button to the ribbon (Where do you want it ?)
Add your macro to the Cell menu (right click menu)


What do you want ?
Let me know and I will make a example for you

Post the code from Dave so I can use it in my example

 

[Ray]

Hi Ron -

I think I understand the options below (esp the QAT), but not sure
about the Ribbon .. let me know if I misunderstood or if you need
further info.

I think the best option is to add a button to the Ribbon, on the Home
tab. I don't really use the 'Styles' section too much, except for
Conditional Formatting .... could that one be moved to Data menu?

Complete code from Dave below ...

Thanks alot for your help!
br//ray

NavToolBar code from Dave Peterson:
Option Explicit
Sub Auto_Close()
On Error Resume Next
Application.CommandBars("MyNavigator").Delete
On Error GoTo 0
End Sub
Sub Autpen()
'code written by Dave Peterson 2005-12-21
'creates a toolbar with list of sheets in active workbook

Dim cb As CommandBar
Dim ctrl As CommandBarControl

On Error Resume Next
Application.CommandBars("MyNavigator").Delete
On Error GoTo 0

Set cb = Application.CommandBars.Add(Name:="myNavigator",
Position:=msoBarBottom, temporary:=True)
With cb
.Visible = True
Set ctrl = .Controls.Add(Type:=msoControlButton,
temporary:=True)
With ctrl
.Style = msoButtonCaption
.Caption = "Refresh Worksheet List"
.OnAction = ThisWorkbook.Name & "!refreshthesheets"
End With

Set ctrl = .Controls.Add(Type:=msoControlComboBox,
temporary:=True)
With ctrl
.Width = 300
.AddItem "Click Refresh First"
.OnAction = ThisWorkbook.Name & "!changethesheet"
.Tag = "__wksnames__"
End With
End With

End Sub
Sub ChangeTheSheet()

Dim myWksName As String
Dim wks As Object
Dim IsHidden As Boolean

With Application.CommandBars.ActionControl
If .ListIndex = 0 Then
MsgBox "Please select an existing sheet"
Exit Sub
Else
myWksName = .List(.ListIndex)
End If
End With

If LCase(myWksName) Like LCase("*--HIDDEN") Then
myWksName = Left(myWksName, Len(myWksName) - Len("--HIDDEN"))
End If

Set wks = Nothing
On Error Resume Next
Set wks = Sheets(myWksName)
On Error GoTo 0

If wks Is Nothing Then
Call RefreshTheSheets
MsgBox "Please try again"
Else
wks.Visible = xlSheetVisible
wks.Select
End If

End Sub
Sub RefreshTheSheets()
Dim ctrl As CommandBarControl
Dim wks As Object
Dim myMsg As String

Set ctrl = Application.CommandBars("myNavigator") _
.FindControl(Tag:="__wksnames__")
ctrl.Clear

For Each wks In ActiveWorkbook.Sheets
If wks.Visible = xlSheetVisible Then
myMsg = ""
Else
myMsg = "--HIDDEN"
End If
ctrl.AddItem wks.Name & myMsg
Next wks
End Sub

 

[Ron de Bruin]

Hi Ray

I will post a ribbon example this evening for you



--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm

Hi Ron -

I think I understand the options below (esp the QAT), but not sure
about the Ribbon .. let me know if I misunderstood or if you need
further info.

I think the best option is to add a button to the Ribbon, on the Home
tab. I don't really use the 'Styles' section too much, except for
Conditional Formatting .... could that one be moved to Data menu?

Complete code from Dave below ...

Thanks alot for your help!
br//ray

NavToolBar code from Dave Peterson:
Option Explicit
Sub Auto_Close()
On Error Resume Next
Application.CommandBars("MyNavigator").Delete
On Error GoTo 0
End Sub
Sub Autpen()
'code written by Dave Peterson 2005-12-21
'creates a toolbar with list of sheets in active workbook

Dim cb As CommandBar
Dim ctrl As CommandBarControl

On Error Resume Next
Application.CommandBars("MyNavigator").Delete
On Error GoTo 0

Set cb = Application.CommandBars.Add(Name:="myNavigator",
Position:=msoBarBottom, temporary:=True)
With cb
.Visible = True
Set ctrl = .Controls.Add(Type:=msoControlButton,
temporary:=True)
With ctrl
.Style = msoButtonCaption
.Caption = "Refresh Worksheet List"
.OnAction = ThisWorkbook.Name & "!refreshthesheets"
End With

Set ctrl = .Controls.Add(Type:=msoControlComboBox,
temporary:=True)
With ctrl
.Width = 300
.AddItem "Click Refresh First"
.OnAction = ThisWorkbook.Name & "!changethesheet"
.Tag = "__wksnames__"
End With
End With

End Sub
Sub ChangeTheSheet()

Dim myWksName As String
Dim wks As Object
Dim IsHidden As Boolean

With Application.CommandBars.ActionControl
If .ListIndex = 0 Then
MsgBox "Please select an existing sheet"
Exit Sub
Else
myWksName = .List(.ListIndex)
End If
End With

If LCase(myWksName) Like LCase("*--HIDDEN") Then
myWksName = Left(myWksName, Len(myWksName) - Len("--HIDDEN"))
End If

Set wks = Nothing
On Error Resume Next
Set wks = Sheets(myWksName)
On Error GoTo 0

If wks Is Nothing Then
Call RefreshTheSheets
MsgBox "Please try again"
Else
wks.Visible = xlSheetVisible
wks.Select
End If

End Sub
Sub RefreshTheSheets()
Dim ctrl As CommandBarControl
Dim wks As Object
Dim myMsg As String

Set ctrl = Application.CommandBars("myNavigator") _
.FindControl(Tag:="__wksnames__")
ctrl.Clear

For Each wks In ActiveWorkbook.Sheets
If wks.Visible = xlSheetVisible Then
myMsg = ""
Else
myMsg = "--HIDDEN"
End If
ctrl.AddItem wks.Name & myMsg
Next wks
End Sub

 

[Ron de Bruin]

I already see a bug that the code blow when you select a sheet that is not in the workbook
before you refresh the sheet list.

Will correct that after your comments

 

[Ray]

hi ron -

my comments on .... ?

My experience with the code (as written) is that if I change windows
(ie workbooks) and then use the NavToolBar to select a sheet (without
refreshing), the code will kick me into previously selected workbook.
An annoyance at times, but my own fault for now 'refreshing' ...
however, if there's a way to auto-refresh upon changing active
workbooks, that'd be even better!

//ray

 

[Ron de Bruin]

Hi Ray

I will check that out today and when it is ready you can download the file
from Debra's site so that there are two versions on that page.

I will post it here when it is online

 

[Ron de Bruin]

Hi Ray

It is online
http://www.contextures.com/xlToolbar01b.html

 

[Ray]

Thanks very much to Ron de Bruin for adapting Dave Peterson's
fantastic code to use in XL2007!

For anyone searching for an add-in to ease intra-workbook navigation,
look no further ...