VBAでExcelの目次シートを作成

• 目次用シートを作成して、そのシート上に前シートに対するリンクを設置するマクロ

VBA

Sub SetSheetTitleList()
    Dim i As Long

    '----------------------------------------------
    ' ベース作成
    '----------------------------------------------

    ' シート作成
    Worksheets.Add(Before:=Worksheets(1)).Name = Format(Now(), "目次_yyyymmdd_hhnnss")
    ActiveWindow.DisplayGridlines = False

    ' 見出し作成
    Range("A1").Value = "目次"
    Range("B3").Value = "シート"
    Range("C3").Value = "説明"

    ' シートリンク作成
    For i = 2 To Sheets.Count ' 目次シート自体は除外
        Range("B" & (i + 2)).Value = Worksheets(i).Name
            Worksheets(1).Hyperlinks.Add Anchor:=Range("B" & (i + 2)), Address:="", SubAddress:="'" & Worksheets(i).Name & "'" & "!A1", TextToDisplay:=Worksheets(i).Name
    Next i


    '----------------------------------------------
    ' レイアウト調整
    '----------------------------------------------

    Range("B3:C3").Select

    ' 見出し色
    With Selection.Font
        .ThemeColor = xlThemeColorDark1
    End With
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorLight2
    End With

    ' 列幅調整
    Columns("B:B").EntireColumn.AutoFit
    Columns("C:C").ColumnWidth = 55

    ' 表を選択
    Range("B3:C" & Sheets.Count + 2).Select

    ' グリッド線を引く
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ThemeColor = 1
        .TintAndShade = -0.4
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ThemeColor = 1
        .TintAndShade = -0.4
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ThemeColor = 1
        .TintAndShade = -0.4
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ThemeColor = 1
        .TintAndShade = -0.4
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ThemeColor = 1
        .TintAndShade = -0.4
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ThemeColor = 1
        .TintAndShade = -0.4
        .Weight = xlThin
    End With

    Range("A1").Select

End Sub