Excelでブック内のシート目次を作ってくれるマクロ

mokujiCreate.vba

'元ネタはこちら。
'ExcelVBA：マクロでページ数を取得してシート一覧表を作成する方法 | オコモトットとプログラム | オコモトットと。 | オコモトットと。
'http://okomotot.com/?p=1685
'
Sub 別シートで目次生成()

    Dim mysheet As Worksheet    '各シート
    Dim page_sum As Integer     'ページ数
    Dim list() As Variant       'シート名とページ数格納用
    Dim i As Integer            '配列添え字用
    Dim maxi As Integer         '配列最大添え字用

    '-----------------------------------------
    ' シート名とページ数を配列に代入
    '-----------------------------------------
    maxi = 0

    'ブックの各シートごとに
    For Each mysheet In Worksheets

        'シートのページ数取得
        mysheet.Activate
        page_sum = Application.ExecuteExcel4Macro("get.document(50)")

        '配列にシート名とページ数を代入
        ReDim Preserve list(1, maxi)
        list(0, maxi) = mysheet.Name
        list(1, maxi) = page_sum
        maxi = maxi + 1

    Next mysheet

    '-----------------------------------------
    ' 配列を新規ブックに転記
    '-----------------------------------------

    '新規ブック追加
    Workbooks.Add
    'ActiveSheet.Name = "シート一覧"

    'リストタイトル設定
    Range("A1").Value = "ページ番号"
    Range("B1").Value = "シート名"

    '配列転記
    'i=0をi=1にすれば2つめのシートから計算してくれます。
    For i = 0 To maxi - 1
        Range("B" & i + 2) = list(0, i)
        '最初のページ番号は自分で指定する。
        If i = 0 Then
            Range("A" & i + 2) = 1
        Else
            Range("A" & i + 2) = (CInt(Range("A" & i + 1).Value) + list(1, i - 1))
        End If
    Next

End Sub