Excel

Alphabetized Table of Contents with Toolbar Buttons

Ease of Use

Easy

Version tested with

2000 

Submitted by:

XLGibbs

Description:

This code inserted into a project or workbook would allow the ongoing creation of a custom toolbar which acts as a table of contents for the workbook it is created from. Since it is workbook specific, the code provided allows for deletion of the toolbar when the workbook is closed or deactivated. Once the code is inserted into a workbook, it is self sustaining within that workbook. 

Discussion:

Sometimes there are workbooks with so many sheets and/or charts, or the names are too long, that navigating to those sheets using the tabs is cumbersome or inconvenient. This toolbar "on the fly" allows for quick toggling between the list of sheets by having a button for each sheet or chart on separate toolbar menus. Application of this code is fairly easy, however, since it is designed to be contained in only one workbook at a time. This code can appear and work in multiple files open at the same time, but it is imperative that the Workbook level code be applied to ensure that the toolbar created is only for the active workbook. 

Code:

instructions for use 

			
 'THIS CODE GOES IN STANDARD MODULE
Option Explicit 
 
Sub CreateSheetList() 
    Dim wb As Workbook, cBar As CommandBar, cBarItem As CommandBarButton, cBarButton As CommandBarPopup 
    Dim sheetnames() As String, i, SheetCount As Integer, chartnames() As String, chartcount As Integer 
     
    Toggle 'sub routine to toggle events and screenupdating (see below)
     
    Call DeleteSheetList 'delete the list before creating it
    Set wb = ActiveWorkbook 'will run in the currently active workbook...
     
    With wb 'perform the following actions in the defined wb object
         
        SheetCount = ActiveWorkbook.Sheets.Count 'sets the count of worksheets
        Set cBar = Application.CommandBars.Add("Sheet List", Position:=msoBarTop, _ 
        Temporary:=True) 'adds the toolbar
         
        Set cBar = Application.CommandBars("Sheet List") 'set a reference to the new command bar
        With cBar 'perform below on the new cBar
             
            Set cBarButton = cBar.Controls.Add(Type:=msoControlPopup) 
            cBarButton.Caption = "GoTo Sheet" 'add a drop down label on the toolbar
             
             
             'fill an array with sheet names
            ReDim sheetnames(1 To SheetCount) 're dimensions the string array to the number of sheets
            For i = 1 To UBound(sheetnames) 'for each sheet in worksheets
                sheetnames(i) = Sheets(i).Name 'adds each sheet name to the array
            Next i 
             
            Call BubbleSort(sheetnames) ' call the sort names subroutine
             
            For i = 1 To SheetCount 'for each item in the sheetnames sorted array
                 
                If Sheets(sheetnames(i)).Visible = True Then ' skips hidden sheets
                     
                    Set cBarItem = cBarButton.Controls.Add(Type:=msoControlButton) 'adds a button
                    With cBarItem 
                        .Caption = sheetnames(i) 'labels the button with the sheet name
                        .OnAction = "'SheetCall """ & .Caption & """'" 'assigns macro and sheetname as passed variable
                        .FaceId = 142 'add an excel icon
                        .BeginGroup = True 'add a divider line
                        .Style = msoButtonIconAndCaption 'shows icon and sheet name
                    End With 
                     
                End If 
                 
            Next i 'next item in worksheet array (next worksheet)
             
            chartcount = wb.Charts.Count 'if any charts
            Debug.Print chartcount 
            If chartcount > 0 Then 'if there are charts create a chart bar
                 
                Set cBarButton = cBar.Controls.Add(Type:=msoControlPopup) 
                cBarButton.Caption = "GoTo Chart" 'add a drop down label on the toolbar
                 
                ReDim charttnames(1 To chartcount) 're dimensions the string array to the number of sheets
                For i = 1 To chartcount 'for each sheet in worksheets
                    sheetnames(i) = Charts(i).Name 'adds each sheet name to the array (reusing sheetnames)
                Next i 
                 
                If chartcount > 1 Then Call BubbleSort(sheetnames) ' call the sort names subroutine
                 
                For i = 1 To chartcount 'for each item in the sheetnames sorted array
                    If Charts(sheetnames(i)).Visible = True Then ' skips hidden sheets
                        Set cBarItem = cBarButton.Controls.Add(Type:=msoControlButton) 'adds a button
                        With cBarItem 
                            .Caption = sheetnames(i) 'labels the button with the sheet name
                            .OnAction = "'ChartCall """ & .Caption & """'" 'assigns macro and sheetname as passed variable
                            .FaceId = 142 'add an excel icon
                            .BeginGroup = True 'add a divider line
                            .Style = msoButtonIconAndCaption 'shows icon and sheet name
                        End With 
                    End If 
                Next i 'next item in chart array (next worksheet)
            End If 'end if chartcount >0 check
             
        End With 'end the "With Cbar"
         
    End With 'end "With Wb"
     
    cBar.Visible = True 'show the new toolbar
    Toggle 'turn on screenupdating and events (see sub below)
    Set cBar = Nothing: Set cBarItem = Nothing: Set cBarButton = Nothing: Set wb = Nothing 
     
End Sub 
Sub BubbleSort(sheetnames() As String) 
     
     'Sorts the List array in ascending order
     
    Dim First As Integer, Last As Integer 
    Dim i As Integer, j As Integer, Temp As String 
     
    First = LBound(sheetnames): Last = UBound(sheetnames) 
    For i = First To Last - 1 
        For j = i + 1 To Last 
            If UCase(sheetnames(i)) > UCase(sheetnames(j)) Then 
                Temp = sheetnames(j) 
                sheetnames(j) = sheetnames(i) 
                sheetnames(i) = Temp 
            End If 
        Next j 
    Next i 
     
End Sub 
 
 
Sub Toggle() 
     'custom sub to simplify toggling the below functions...
    With Application 
        .ScreenUpdating = Not .ScreenUpdating 
        .EnableEvents = Not .EnableEvents 
    End With 
End Sub 
Sub DeleteSheetList() 
     
    On Error Resume Next 'delete the toolbar if it creates.  If it is not there, keep going..
    Application.CommandBars("Sheet List").Delete 
    Application.CommandBars("Chart List").Delete 
    On Error Goto 0 
     
End Sub 
Sub SheetCall(ByVal Sh As String) 
     
    On Error Goto ErrHandler 
     
    Sheets(Sh).Activate 
     'this macro is assigned to each button on the created toolbar,
     'each macro is assigned the sheet name as a variable to pass to the routine...
    Exit Sub 
ErrHandler: 'If a sheet rename or delete was not captured by the workbook events
    CreateSheetList 
     
End Sub 
 
Sub ChartCall(ByVal Ch As String) 
     
    On Error Goto ErrHandler 
    Charts(Ch).Activate 
     'this macro is assigned to each button on the created toolbar,
     'each macro is assigned the sheet name as a variable to pass to the routine...
    Exit Sub 
ErrHandler: 'If a chart rename or delete was not captured by the workbook events
    CreateSheetList 
End Sub 
 
 
 ''''''''''''THIS CODE GOES IN WORKBOOK MODULE'''''''''''''''
Option Explicit 
 
Private Sub Workbook_Activate() 
     'recreates the toolbar when the workbook is re-activated..
    CreateSheetList 
End Sub 
 
Private Sub Workbook_BeforeClose(Cancel As Boolean) 
     'Deletes the toolbar on close so that it is not present in other workbooks
    DeleteSheetList 
End Sub 
 
Private Sub Workbook_Deactivate() 
     'kills the custom toolbar when the workbook is not active,
     'buttons won't work in another workbook where the toolbar is not created separately
    DeleteSheetList 
End Sub 
 
Private Sub Workbook_NewSheet(ByVal Sh As Object) 
    CreateSheetList 
End Sub 
 
Private Sub Workbook_Open() 'Optional, if you want this button to always be created on file open..
    CreateSheetList 
End Sub

How to use:

  1. Open Excel, and Open the Visual Basic Editor (Press Alt-F11, or Tools>Macros>Visual Basic Editor)
  2. Right click the VBAProject for your workbook and Insert > Module
  3. Paste the top portion of the code (Designated with "Standard Module") into the code window.
  4. Double Click the "Workbook" module in your project. Paste the Workbook module code provided in the code window.
  5. Save your workbook, and run the code in the standard module "CreateSheetList" by pressing the green play button in the VBE window, or by pressing Alt-F8 in the workbook window.
  6. The toolbar will be created and you will see the title "GoTo Sheets" and/or "GoTo Chart". The sheets in your workbook can be activated by selecting them from this list.
 

Test the code:

  1. After placing the code in a workbook and saving, open up another workbook so there are two active in windows.
  2. Simply go back and forth between the two files (one with, one without the code) to see the toolbar appear and dissappear.
  3. Or you can insert all of the code as instructed, close and re-open your file.
  4. The attached sample is a working demonstration.
  5. Note: For code simplicity, adding/deleting/renaming a sheet is not captured, however, the changes will be reflected on the toolbar if the workbook is closed and reopened, or deactivated and reactivated.
 

Sample File:

SheetListToolbar_V2.1.zip 146.69KB 

Approved by mdmackillop


This entry has been viewed 299 times.

Please read our Legal Information and Privacy Policy
Copyright @2004 - 2012 VBA Express