I use the following set of subroutines to create a toolbar with a
ComboBox and a ControlButton that docks to the right of my Standard
Toolbar. It alphabetizes the worksheet names in the ComboBox. When I
switch workbooks, I just hit the Button and it brings up all the
worksheets in that workbook.
I adapted this from some code provided by Dave Peterson. I placed this
in my Personal.xls workbook. NewMenu is called in the Workbook_Open
event. Watch for linewrap.
----------------------------------------------------------------------------------------------------------
Sub NewMenu()
'' Display new toolbar with a combobox and button to change sheets.
Dim Cb As CommandBar, Cbstd As CommandBar
Dim Ctrl As CommandBarControl
On Error Resume Next
Application.CommandBars("SheetSelector").Delete
On Error GoTo 0
Set Cbstd = Application.CommandBars("Standard")
Set Cb = Application.CommandBars.Add(Name:="SheetSelector",
Temporary:=True)
With Cb
.Visible = True
Set Ctrl = .Controls.Add(Type:=msoControlButton,
Temporary:=True)
With Ctrl
.Style = msoButtonCaption
.Caption = "Worksheet List"
.OnAction = ThisWorkbook.Name & "!AllWorksheets"
End With
Set Ctrl = .Controls.Add(Type:=msoControlComboBox,
Temporary:=True)
With Ctrl
.AddItem "Click Worksheet List"
.OnAction = ThisWorkbook.Name & "!SelectSheet"
.Tag = "Where"
.DropDownLines = 12
End With
End With
With Application
.CommandBars("SheetSelector").Position =
..CommandBars("Standard").Position
.CommandBars("SheetSelector").RowIndex =
..CommandBars("Standard").RowIndex
.CommandBars("SheetSelector").Left =
..CommandBars("Standard").Width + 1
End With
End Sub
Sub SelectSheet()
'' Select a worksheet.
Static bHidden As Boolean
Dim strSheet As String
Dim wSht As Worksheet
With Application.CommandBars.ActionControl
strSheet = .List(.ListIndex)
End With
Set wSht = Nothing
On Error Resume Next
Set wSht = Worksheets(strSheet)
On Error GoTo 0
If wSht Is Nothing Then
AllWorksheets
Else
If bHidden Then ActiveSheet.Visible = False: bHidden = False
With wSht
If .Visible = False Then .Visible = True: bHidden = True
.Select
End With
End If
End Sub
Sub AllWorksheets()
'' Loads the ActiveWorkBook's Sheet' Names into ComboBox
Dim Ctrl As CommandBarControl
Dim intC As Integer, intCount As Integer
Dim strSheets() As String
Dim wSht As Worksheet
Set Ctrl =
Application.CommandBars("SheetSelector").FindControl(Tag:="Where")
Ctrl.Clear
intCount = ActiveWorkbook.Sheets.Count
ReDim strSheets(1 To intCount)
For intC = 1 To intCount
strSheets(intC) = ActiveWorkbook.Sheets(intC).Name
Next intC
Call BubbleSort(strSheets, strSheets)
For intC = 1 To intCount
Ctrl.AddItem strSheets(intC)
Next intC
End Sub
Sub BubbleSort(strList() As String, strSecond() As String)
'' Sorts an array.
Dim intFirst As Integer, intLast As Integer
Dim intI As Integer, intJ As Integer
Dim strTemp As String, strTemp2 As String
intFirst = LBound(strList)
intLast = UBound(strList)
For intI = intFirst To intLast - 1
For intJ = intI + 1 To intLast
If strList(intI) > strList(intJ) Then
strTemp = strList(intJ)
strTemp2 = strSecond(intJ)
strList(intJ) = strList(intI)
strSecond(intJ) = strSecond(intI)
strList(intI) = strTemp
strSecond(intI) = strTemp2
End If
Next intJ
Next intI
End Sub
Using Excel 97SR2 on Windows 98SE,
HTH
Paul