【VBA】目次シートを作成する

PR

サンプルプログラムで作成する目次シート

ハイパーリンク付きのシート名の一覧を作成する

PR

サンプルプログラム概要

1.目次シートが存在する場合は削除

2.一番左に目次シートを追加

3.目次シート全体の列幅を1.5に設定

4.目次の水平位置と垂直位置を設定

5.不要列/不要行を非表示

6.メモリ線を非表示

7.微調整
 ・列幅を自動調整
 ・セル「A1」を選択

PR

サンプルプログラム

Option Explicit

Sub createIndex()

    Const INDEX_SHEET_NAME As String = "目次"
    Const CULUMN_SHEET_NAME As Integer = 2
    
    Dim i As Integer
    Dim num As Integer
    Dim indexSheet As Worksheet
    Dim endRow As Double
    
    '
    '目次シートが存在する場合は削除
    '
    For i = 1 To Worksheets.Count
        If Worksheets(i).Name = INDEX_SHEET_NAME Then
        
            Application.DisplayAlerts = False
            Worksheets(INDEX_SHEET_NAME).Delete
            Application.DisplayAlerts = True
            
            Exit For
        End If
    Next i
    
    '
    '一番左に目次シートを追加
    '
    Set indexSheet = Worksheets.Add(Before:=Worksheets(1))
    indexSheet.Name = INDEX_SHEET_NAME
    
    '
    '目次シート全体の列幅を1.5に設定
    '
    indexSheet.Cells.Select
    Selection.ColumnWidth = 1.5
    
    '
    '目次の作成
    '
    With indexSheet
        .Range("A1") = INDEX_SHEET_NAME
        .Range("A1").Font.Size = 14
        .Range("A1").Font.Bold = True
    End With
    
    num = 1
    
    For i = 1 To Worksheets.Count
    
        If Worksheets(i).Name <> INDEX_SHEET_NAME Then
            '各シートへのリンクを作成
            indexSheet.Hyperlinks.Add Anchor:=Cells(num + 2, CULUMN_SHEET_NAME), _
            Address:="", _
            SubAddress:=Worksheets(i).Name & "!A1", _
            TextToDisplay:=Worksheets(i).Name
            
            num = num + 1
        End If
        
    Next i
    
    '
    '目次の水平位置と垂直位置を設定
    '
    With indexSheet.Columns(CULUMN_SHEET_NAME)
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlCenter
    End With
    
    '
    '不要列を非表示
    '
    Columns("D").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.EntireColumn.Hidden = True
    
    '最終行を取得
    endRow = Cells(Rows.Count, CULUMN_SHEET_NAME).End(xlUp).Row

    '
    '不要行を非表示
    '
    Rows(endRow + 2).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.EntireRow.Hidden = True

    '
    'メモリ線を非表示
    '
    ActiveWindow.DisplayGridlines = False
    
    '
    '微調整
    '
    Cells.Columns.AutoFit
    indexSheet.Range("A1").Select
    
End Sub
タイトルとURLをコピーしました