hiko-blog

VBA業務改善

MENU

Excelシート 目次作成

Sub CreateTableOfContents()
    Dim ws As Worksheet
    Dim tocSheet As Worksheet
    Dim rowNum As Integer
    Dim sheetNum As Integer
    
    ' 新しいシートを作成して目次を作成
    Set tocSheet = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
    tocSheet.Name = "目次"
    tocSheet.Range("B1").Value = "目次"
    rowNum = 2
    sheetNum = 1
    
    ' 各シートについてループ処理
    For Each ws In ThisWorkbook.Sheets
        ' 目次に追加しないシートをスキップ
        If ws.Name <> tocSheet.Name Then
            ' シートへのリンクを追加
            tocSheet.Hyperlinks.Add Anchor:=tocSheet.Cells(rowNum, 2), Address:="", SubAddress:="'" & ws.Name & "'!A1", TextToDisplay:=ws.Name
            ' 番号を振る
            tocSheet.Cells(rowNum, 1).Value = sheetNum & "."
            rowNum = rowNum + 1
            sheetNum = sheetNum + 1
        End If
    Next ws
    
    ' 目次シートの装飾
    With tocSheet.Range("A2:A" & rowNum - 1)
        .Font.Bold = True
        .Columns(1).AutoFit
    End With
End Sub