Excel VBA Macro to Create Index with Table of Contents in a Report
The following Macro will create an Index Tab called "MY_INDEX" and in this Tab it will create the Table of Contents with list of Sheet names available in ThisWorkbook with Hyperlinks directing you to respective Sheet .
Next in each Tab except <Index Tab> it will create the <Back to Index> button with Hyperlink directing you to <Index Tab>.
Sub Add_My_Index()
Dim K As Long
On Error Resume Next
Application.DisplayAlerts = False
'Deleting an old Index if it already exist with the Name<MY_INDEX>
ThisWorkbook.Sheets("MY_INDEX").Delete
Application.DisplayAlerts = True
On Error GoTo 0
'Adding an Index tab in ThisWorkbook with the Name<MY_INDEX>
ThisWorkbook.Sheets.Add Before:=ThisWorkbook.Worksheets(1)
ActiveSheet.Name = "MY_INDEX"
ThisWorkbook.Sheets("MY_INDEX").Cells(1, 1) = "INDEX"
'Adding and formatting the Index title in <MY_INDEX> Tab
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0.349986266670736
.PatternTintAndShade = 0
End With
With Selection.Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
End With
Selection.Font.Bold = True
With Selection.Font
.Name = "Calibri"
.Size = 14
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
End With
ActiveCell.ColumnWidth = 35
'Looping through other than <MY_INDEX> tab to add <Back to Index> Button.
For K = 2 To Sheets.Count
ThisWorkbook.Sheets("MY_INDEX").Activate
ActiveSheet.Cells(K, 1).Select
ActiveSheet.Hyperlinks.Add _
Anchor:=ActiveSheet.Cells(K, 1), Address:="", _
SubAddress:="'" & Sheets(K).Name & "'!A1", TextToDisplay:=Sheets(K).Name
If Sheets(K).Name = "INDEX" Then GoTo NxtSht
Sheets(K).Activate
ActiveSheet.Rows("1:1").RowHeight = 30.75
ActiveSheet.Columns("A:A").ColumnWidth = 16.29
ActiveSheet.Range("A1").Select
'Adding < Back to Index > button in Other tabs
ActiveSheet.Shapes.AddShape(msoShapeRoundedRectangle, 1.5, 2.25, 85.5,25.5).Select
Selection.ShapeRange.ShapeStyle = msoShapeStylePreset31
Selection.Placement = xlFreeFloating
'Renaming <Shape Name> and Storing the Name in a Variable
Selection.ShapeRange.Name = "Back2Index"
Z = Selection.ShapeRange.Name
'Adding the Text as <Back to Index> in the Shape
Selection.ShapeRange(Z).TextFrame2.TextRange.Characters.Text = "Back to Index"
With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 13). _
ParagraphFormat
.FirstLineIndent = 0
.Alignment = msoAlignLeft
End With
'Formatting the Shape Color Themes
With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 13).Font
.Bold = msoTrue
.NameComplexScript = "+mn-cs"
.NameFarEast = "+mn-ea"
.Fill.Visible = msoTrue
.Fill.ForeColor.ObjectThemeColor = msoThemeColorLight1
.Fill.ForeColor.TintAndShade = 0
.Fill.ForeColor.Brightness = 0
.Fill.Transparency = 0
.Fill.Solid
.Size = 11
.Name = "+mn-lt"
End With
'Adding the Hyperlink to Shape targeting to INDEX Tab
ActiveSheet.Shapes.Range(Array(Z)).Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection.ShapeRange.Item(1), Address:="", _
SubAddress:="'" & Sheets(1).Name & "'!A1", TextToDisplay:=""
ActiveSheet.Range("A2").Select
NxtSht:
Next K
ThisWorkbook.Sheets("MY_INDEX").Activate
ActiveSheet.Cells(1, 1).Select
End Sub
-------------------------------------------------------------------------------
The above Macro will create an Index Tab with Report Index ( Hyper links to each Tab of the Report) as follows :
and in each tab of the report , a <Back to Index> button will be created as follows :
The following Macro will create an Index Tab called "MY_INDEX" and in this Tab it will create the Table of Contents with list of Sheet names available in ThisWorkbook with Hyperlinks directing you to respective Sheet .
Next in each Tab except <Index Tab> it will create the <Back to Index> button with Hyperlink directing you to <Index Tab>.
Sub Add_My_Index()
Dim K As Long
On Error Resume Next
Application.DisplayAlerts = False
'Deleting an old Index if it already exist with the Name<MY_INDEX>
ThisWorkbook.Sheets("MY_INDEX").Delete
Application.DisplayAlerts = True
On Error GoTo 0
'Adding an Index tab in ThisWorkbook with the Name<MY_INDEX>
ThisWorkbook.Sheets.Add Before:=ThisWorkbook.Worksheets(1)
ActiveSheet.Name = "MY_INDEX"
ThisWorkbook.Sheets("MY_INDEX").Cells(1, 1) = "INDEX"
'Adding and formatting the Index title in <MY_INDEX> Tab
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0.349986266670736
.PatternTintAndShade = 0
End With
With Selection.Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
End With
Selection.Font.Bold = True
With Selection.Font
.Name = "Calibri"
.Size = 14
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
End With
ActiveCell.ColumnWidth = 35
'Looping through other than <MY_INDEX> tab to add <Back to Index> Button.
For K = 2 To Sheets.Count
ThisWorkbook.Sheets("MY_INDEX").Activate
ActiveSheet.Cells(K, 1).Select
ActiveSheet.Hyperlinks.Add _
Anchor:=ActiveSheet.Cells(K, 1), Address:="", _
SubAddress:="'" & Sheets(K).Name & "'!A1", TextToDisplay:=Sheets(K).Name
If Sheets(K).Name = "INDEX" Then GoTo NxtSht
Sheets(K).Activate
ActiveSheet.Rows("1:1").RowHeight = 30.75
ActiveSheet.Columns("A:A").ColumnWidth = 16.29
ActiveSheet.Range("A1").Select
'Adding < Back to Index > button in Other tabs
ActiveSheet.Shapes.AddShape(msoShapeRoundedRectangle, 1.5, 2.25, 85.5,25.5).Select
Selection.ShapeRange.ShapeStyle = msoShapeStylePreset31
Selection.Placement = xlFreeFloating
'Renaming <Shape Name> and Storing the Name in a Variable
Selection.ShapeRange.Name = "Back2Index"
Z = Selection.ShapeRange.Name
'Adding the Text as <Back to Index> in the Shape
Selection.ShapeRange(Z).TextFrame2.TextRange.Characters.Text = "Back to Index"
With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 13). _
ParagraphFormat
.FirstLineIndent = 0
.Alignment = msoAlignLeft
End With
'Formatting the Shape Color Themes
With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 13).Font
.Bold = msoTrue
.NameComplexScript = "+mn-cs"
.NameFarEast = "+mn-ea"
.Fill.Visible = msoTrue
.Fill.ForeColor.ObjectThemeColor = msoThemeColorLight1
.Fill.ForeColor.TintAndShade = 0
.Fill.ForeColor.Brightness = 0
.Fill.Transparency = 0
.Fill.Solid
.Size = 11
.Name = "+mn-lt"
End With
'Adding the Hyperlink to Shape targeting to INDEX Tab
ActiveSheet.Shapes.Range(Array(Z)).Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection.ShapeRange.Item(1), Address:="", _
SubAddress:="'" & Sheets(1).Name & "'!A1", TextToDisplay:=""
ActiveSheet.Range("A2").Select
NxtSht:
Next K
ThisWorkbook.Sheets("MY_INDEX").Activate
ActiveSheet.Cells(1, 1).Select
End Sub
-------------------------------------------------------------------------------
The above Macro will create an Index Tab with Report Index ( Hyper links to each Tab of the Report) as follows :
and in each tab of the report , a <Back to Index> button will be created as follows :
--------------------------------------------------------------------------------------------------------
Thanks, TAMATAM ; Business Intelligence & Analytics Professional
--------------------------------------------------------------------------------------------------------
Thanks, TAMATAM ; Business Intelligence & Analytics Professional
--------------------------------------------------------------------------------------------------------
No comments:
Post a Comment
Hi User, Thank You for visiting My Blog. Please post your genuine Feedback or comments only related to this Blog Posts. Please do not post any Spam comments or Advertising kind of comments which will be Ignored.