Hướng dẫn chi tiết cách tạo mục lục tự động theo các sheet trong Excel

Cách 1: Tạo mục lục thủ công

Cách này thường dùng cho file Excel của bạn khi ít có sự thay đổi về sheet (không thêm, sửa, xóa sheet Excel) hoặc số lượng sheet không lớn. Bạn thực hiện như sau:

Bước 1: Tạo một sheet để chứa danh sách mục lục của bạn.

Bước 2: Chọn tên sheet, click chuột phải chọn Hyperlink...

Bước 3: Hộp thoại Insert Hyperlink hiện ra → chọn Place in This Document → chọn tên sheet tương ứng ở cột bên cạnh → chọn OK.

Bước 4: Vị trí bạn vừa đặt Hyperlink sẽ xuất hiện liên kết, bạn chỉ cần click vào đó là sẽ ra sheet tương ứng.

Tương tự như vậy bạn thực hiện với danh sách các sheet còn lại là sẽ hoàn thành mục lục cho bảng Excel.

Cách 2: Tạo mục lục tự động bằng VBA

Bước 1: Nhấn tổ hợp phím Alt + F11 để mở Visual Basic for Applications

Bước 2: Hộp thoại VBA xuất hiện, chọn Insert → Module

Bước 3: Hộp thoại Module xuất hiện, bạn copy toàn bộ đoạn code sau vào khung Module:

Option Explicit

Sub TEST_CreateLeadsheet()
Call CreateLeadsheets(False, False)
End Sub

Sub TEST_CreateLeadsheets2()
Call CreateLeadsheets(True, True)
End Sub

Sub TEST_CreateLeadsheets3()
Call CreateLeadsheets(False, True)
End Sub

Sub TEST_CreateLeadsheets4()
Call CreateLeadsheets(True, False)
End Sub

Sub CreateLeadsheets(Optional ByVal IncludeHiddenSheets As Boolean = False, _
Optional ByVal AddHomeLinkOnSheets As Boolean = False)
'
' IncludeHiddenSheets
' Boolean
' Specifies whether or not hidden sheets should be included in the Table of Contents
'
' AddHomeLinkOnSheets
' Boolean
' Specifies whether or not a link should be placed in each sheet linking back to the
' Table of Contents. This will only be placed on worksheets (i.e. not chart sheets),
' will not work with a protected sheet, and will overwrite anything in the cell
' specified in the destination [address] constant below (under declared variables).
'
'Use cases:
'Call CreateLeadsheets(False, False)
' This will create a Table of Contents which excludes hidden sheets and does not add a link
' back to itself
'
'Call CreateLeadsheets(True, True)
' This will create a Table of Contents which includes hidden sheets and also includes a link
' back to itself.
'*** CAUTION: Specifying a cell in each sheet will 1) only work on worksheets (i.e. not chart sheets),
' overwrite anything in the destination cell (unless worksheet is protected)
'
'Call CreateLeadsheets(False, True)
' This will create a Table of Contents which excludes hidden sheets and also includes a link
' back to itself.
'*** CAUTION: Specifying a cell in each sheet will 1) only work on worksheets (i.e. not chart sheets),
' overwrite anything in the destination cell (unless worksheet is protected)
'
'Call CreateLeadsheets(True, False)
' This will create a Table of Contents which includes hidden sheets and does not add a link
' back to itself
'
'Declare all variables
Dim LeadsheetsBook As Workbook
Dim CheckSheet As Worksheet
Dim Leadsheets As Worksheet
Dim ChartButton As Shape
Dim NewRow As Long
Dim SheetCount As Long
Dim CellLeft
Dim CellTop
Dim CellHeight
Dim CellWidth
Dim SheetName As String
Dim Prompt As String
Dim CellR1C1Address As String

'Set a constant to the name of the Table of Contents
Const LeadsheetsName As String = "Leadsheets"
Const HomeCell As String = "A1"
Const StartRow As Long = 5

'Check if a workbook is open or not. If no workbook is open, quit.
If ActiveWorkbook Is Nothing Then
MsgBox "You must have a workbook open first!", vbInformation, "No Open Book"
Exit Sub
End If
Set LeadsheetsBook = ActiveWorkbook

On Error Resume Next
Set Leadsheets = LeadsheetsBook.Worksheets("Leadsheets")
On Error GoTo 0
If Not Leadsheets Is Nothing Then
If MsgBox("Table of contents already exists. Overwrite?", vbYesNo + vbDefaultButton2, "Overwrite Leadsheets?") <> vbYes Then Exit Sub
Application.DisplayAlerts = False
Leadsheets.Delete
Set Leadsheets = Nothing
End If
Set Leadsheets = LeadsheetsBook.Worksheets.Add(Before:=LeadsheetsBook.Sheets(1))
Leadsheets.Name = LeadsheetsName
Leadsheets.Columns(1).ColumnWidth = 1

Leadsheets.Cells(StartRow - 3, "B").Value = "TABLE OF CONTENTS"
If IncludeHiddenSheets Then
Leadsheets.Cells(StartRow - 2, "B").Value = "Hidden sheets are italicized"
Leadsheets.Cells(StartRow - 2, "B").Font.Size = 10
NewRow = StartRow
Else
NewRow = StartRow - 1
End If

For SheetCount = 1 To LeadsheetsBook.Sheets.Count
SheetName = LeadsheetsBook.Sheets(SheetCount).Name
If LeadsheetsBook.Sheets(SheetName).Name = LeadsheetsName Then GoTo SkipSheet
If Not IncludeHiddenSheets And LeadsheetsBook.Sheets(SheetName).Visible <> xlSheetVisible Then GoTo SkipSheet
If IsChart(SheetName) Then
'** Sheet IS a Chart Sheet
'Set variables for button dimensions.
CellLeft = Leadsheets.Range("B" & NewRow).Left
CellTop = Leadsheets.Range("B" & NewRow).Top
CellWidth = Leadsheets.Range("B" & NewRow).Width
CellHeight = Leadsheets.Range("B" & NewRow).RowHeight
CellR1C1Address = "R" & NewRow & "C3"
'Add button to cell dimensions.
Set ChartButton = Leadsheets.Shapes.AddShape(msoShapeRoundedRectangle, CellLeft, CellTop, CellWidth, CellHeight)
ChartButton.Select
'Use older technique to add Chart sheet name to button text.
ExecuteExcel4Macro "FORMULA(""=" & CellR1C1Address & """)"
'Format shape to look like hyperlink and match background color (transparent).
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 0
Selection.Font.Underline = xlUnderlineStyleSingle
Selection.Font.ColorIndex = 0
Selection.ShapeRange.Fill.Visible = msoFalse
Selection.ShapeRange.Line.Visible = msoFalse
Selection.OnAction = "GoLeadsheetshart"
Selection.Name = SheetName
Else
'** Sheet is NOT a Chart sheet. Add a hyperlink to A1 of each sheet.
Leadsheets.Range("B" & NewRow).Hyperlinks.Add Anchor:=Leadsheets.Range("B" & NewRow), Address:="#'" & SheetName & "'!A1", TextToDisplay:=SheetName
If AddHomeLinkOnSheets Then
If LeadsheetsBook.Sheets(SheetName).Type = xlWorksheet Then
If LeadsheetsBook.Sheets(SheetName).ProtectContents = False Then
LeadsheetsBook.Sheets(SheetName).Range(HomeCell).Value = "Leadsheets"
LeadsheetsBook.Sheets(SheetName).Range(HomeCell).Hyperlinks.Add Anchor:=LeadsheetsBook.Sheets(SheetName).Range("A1"), Address:="#'" & LeadsheetsName & "'!A1", TextToDisplay:=LeadsheetsName
End If
End If
End If
End If
'Add name and format sheet name on Leadsheets
Leadsheets.Range("B" & NewRow).Value = SheetName
Leadsheets.Range("B" & NewRow).HorizontalAlignment = xlLeft
Leadsheets.Range("B" & NewRow).Font.Italic = CBool(LeadsheetsBook.Sheets(SheetName).Visible <> xlSheetVisible)
Leadsheets.Range("B" & NewRow).Font.ColorIndex = 5
'Increment row
NewRow = NewRow + 1
SkipSheet:
Next SheetCount

Leadsheets.Activate
Leadsheets.Cells(1, 1).Select

End Sub

Public Function IsChart(cName As String, Optional ChartBook As Workbook) As Boolean

'Will return True or False if sheet is a Chart sheet object or not.
'Can be used as a worksheet function.
Dim tmpChart As Chart
If ChartBook Is Nothing Then
If ActiveWorkbook Is Nothing Then Exit Function
Set ChartBook = ActiveWorkbook
End If

'Function will be determined if the object is not errored
On Error Resume Next
IsChart = IIf(ChartBook.Charts(cName) Is Nothing, False, True)
On Error GoTo 0

End Function

Sub GoLeadsheetshart(Optional Placebo As String = "")

'This routine is to be assigned to button Object for Chart sheets only
'as Chart sheets don't have cell references to hyperlink to.

On Error Resume Next
ActiveWorkbook.Charts(Application.Caller).Activate
On Error GoTo 0
If Err.Number <> 0 Then Exit Sub

'Optional: zoom Chart sheet to fit screen.
'Depending on screen resolution, this may need adjustment(s).
ActiveWindow.Zoom = 80

End Sub

Nguồn: Toàn Nguyễn

Bước 4: Chọn Run → Run Sub (phím tắt F5) để chạy lệnh.

Lúc này bảng Excel của bạn sẽ xuất hiện sheet Leadsheets, ở đây hiển thị danh sách các sheet, bạn muốn mở sheet nào thì chỉ cần click chuột vào tên sheet tương ứng.

Trên đây là 2 cách dễ dàng để bạn có thể tạo mục lục sheet trong Excel. Chúc các bạn thực hiện thành công!