That said, here's a module that will create a Table of Contents worksheet
with a hyperlink to each worksheet.
HTH,
Gary Brown
'================================================= ====Public Sub
WorksheetNamesWithHyperLink()
'Create a separate worksheet with the name of each sheet
' in the workbook as a hyperlink to that sheet -
' i.e. a Table Of Contents
'07/25/2000 - allow for chart sheets
'05/07/2002 - add manual calculation
Dim aryHiddensheets()
Dim iRow As Integer, iColumn As Integer, y As Integer
Dim i As Integer, x As Integer, iSheets As Integer
Dim objOutputArea As Object
Dim strTableName As String, strSheetName As String
Dim strOrigCalcStatus As String
strTableName = "Table_of_Contents"
'save calculation setting
Select Case Application.Calculation
Case xlCalculationAutomatic
strOrigCalcStatus = "Automatic"
Case xlCalculationManual
strOrigCalcStatus = "Manual"
Case xlCalculationSemiautomatic
strOrigCalcStatus = "SemiAutomatic"
Case Else
strOrigCalcStatus = "Automatic"
End Select
'set workbook to manual
Application.Calculation = xlCalculationManual
'Count number of sheets in workbook
iSheets = ActiveWorkbook.Sheets.Count
'redim array
ReDim aryHiddensheets(1 To iSheets)
'put hidden sheets in an array, then unhide the sheets
For x = 1 To iSheets
If Sheets(x).Visible = False Then
aryHiddensheets(x) = Sheets(x).name
Sheets(x).Visible = True
End If
Next
'Check for duplicate Sheet name
i = ActiveWorkbook.Sheets.Count
For x = 1 To i
If Windows.Count = 0 Then Exit Sub
If UCase(Sheets(x).name) = UCase(strTableName) Then
Sheets(x).Activate
If Err.Number = 9 Then
Exit For
End If
'turn warning messages off
Application.DisplayAlerts = False
ActiveWindow.SelectedSheets.Delete
'turn warning messages on
Application.DisplayAlerts = True
Exit For
End If
Next
'Add new sheet at end of workbook
' where results will be located
Sheets.Add.Move Befo=Sheets(1)
'Worksheets.Add.Move after:=Sheets(Sheets.Count)
'Name the new worksheet and set up Titles
ActiveWorkbook.ActiveSheet.name = strTableName
ActiveWorkbook.ActiveSheet.Range("A1").value = _
"Worksheet (hyperlink)"
ActiveWorkbook.ActiveSheet.Range("B1").value = _
"Visible / Hidden"
ActiveWorkbook.ActiveSheet.Range("C1").value = _
" Notes: "
're-hide previously hidden sheets
On Error Resume Next
y = UBound(aryHiddensheets)
For x = 1 To y
Sheets(aryHiddensheets(x)).Visible = False
Next
'Count number of sheets in workbook
iSheets = ActiveWorkbook.Sheets.Count
'Initialize row and column counts for putting
'info into StrTableName sheet
iRow = 1
iColumn = 0
Set objOutputArea = _
ActiveWorkbook.Sheets(strTableName).Range("A1")
'Check Sheet names
For x = 1 To iSheets
Sheets(x).Activate
strSheetName = ActiveSheet.name
'put information into StrTableName worksheet
With objOutputArea
If strSheetName < strTableName Then
.Offset(iRow, iColumn) = " " & strSheetName
If UCase(TypeName(ActiveSheet)) < "CHART" Then
ActiveSheet.Hyperlinks.Add _
Anchor:=objOutputArea.Offset(iRow, _
iColumn), _
Address:="", SubAddress:=Chr(39) & _
strSheetName & Chr(39) & "!A1"
End If
If ActiveSheet.Visible = True Then
.Offset(iRow, iColumn + 1) = " Visible"
.Offset(iRow, iColumn).Font.Bold = True
.Offset(iRow, iColumn + 1).Font.Bold = True
Else
.Offset(iRow, iColumn + 1) = " Hidden"
End If
iRow = iRow + 1
End If
End With
Next x
Sheets(strTableName).Activate
'format worksheet
Range("A:C").Select
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.IndentLevel = 0
.ShrinkToFit = False
.MergeCells = False
End With
With Selection.Font
.name = "Tahoma"
'.FontStyle = "Regular"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
'.ColorIndex = xlAutomatic
End With
Range("A2").Select
ActiveWindow.FreezePanes = True
Range("A1").Font.Bold = True
Columns("A:C").EntireColumn.AutoFit
Range("A1:C1").Select
With Selection
.HorizontalAlignment = xlCenter
.Font.Underline = xlUnderlineStyleSingle
End With
Range("B1").Select
With ActiveCell.Characters(Start:=1, Length:=7).Font
.FontStyle = "Bold"
End With
With ActiveCell.Characters(Start:=8, Length:=9).Font
.FontStyle = "Regular"
End With
Columns("A:C").EntireColumn.AutoFit
Range("A1:C1").Font.Underline = _
xlUnderlineStyleSingleAccounting
Range("B:B").HorizontalAlignment = xlCenter
Range("C1").HorizontalAlignment = xlLeft
Columns("C:C").ColumnWidth = 65
Range("A1").Select
Select Case strOrigCalcStatus
Case "Automatic"
Application.Calculation = xlCalculationAutomatic
Case "Manual"
Application.Calculation = xlCalculationManual
Case "SemiAutomatic"
Application.Calculation = _
xlCalculationSemiautomatic
Case Else
Application.Calculation = xlCalculationAutomatic
End Select
Application.Dialogs(xlDialogWorkbookName).Show
End Sub
'================================================= ====
"Gary Brown" wrote:
In the lower left-hand corner of the worksheet are the directional buttons...
|< , < , , |
Right-click on these buttons and a list of all worksheets in the active
workbook will appear. Highlight the last one and hit enter.
HTH,
Gary Brown
" wrote:
hi,
what i would do is create start tab. on that sheet i would
create a button for each department and put their
department number as the buttons caption.
then for code behind the button i would put something like
Private sub cmd100_click()
Sheets("100").select
Range("A1").select
end sub
and do that for each button(department)
that way whoever opened the file could click their
department button and be taken to their sheet instantly.
repost to this thread if you have questions.
good luck
-----Original Message-----
I have a file that contains many workseet tabs.
The tables are numbered, like, 100, 200, 300, 400, 500,
etc and represent
names of departments
An individual from a given department will open the
workbook, and select
their respective tab.
If thier department number is at the end of the range, it
is difficult for
them to scroll across the bottom of the workbook to find
thier sheet tab.
Is there a better way to organize or find worksheet tabs?
Can worksheet tabs be listed down the left margin instead
of across the
bottom?
Is there a way to create a "table of contents" or
something similar that
will access the individual tabs?
I did see Views, create custom view, and this looks like
it work work,
however since another program creates the excel workbook
and all the tabs
each month, I would have to do a l;ot of manula editing
to create a custom
view. Is there a better way?
.
|