Excelのワークシートの一覧シートを作成するVBAマクロ

はじめに

2008年くらいにWindows版Excelで作成したVBAマクロを見つけたので、Mac版Excelでも動くのか試してみたのですが、大抵動く、という結果でした。
せっかくなので、VBAマクロを切り出して残しておこうと思います。

VBAマクロ

概要

ワークブックに存在するシートの情報を集め、「シート一覧Work」シートにリンク付きのシート一覧を作成します。
「シート一覧Work」は、シートがなければ追加されます。シートがある場合はそのシートを使いますが、都度、値をクリアして作成し直す処理になっているため、必要に応じて調整が必要と思います。

ソース

Option Explicit

'=====================================================================
' シート一覧作成
' -------------------------------------------------------------------
' "シート一覧Work"シートに、シート一覧(リンク付き)を作成する
'=====================================================================
Public Sub MakeSheetList()
    Const LIST_SHEET_NAME = "シート一覧Work"    'シート一覧の物理的なシート名
    Const LIST_NO_COLIDX = 1                    'No. インデックス
    Const LIST_NAME_COLIDX = 2                  '名前 インデックス

    Dim intIdx As Integer       '処理用インデックス
    Dim intWksCnt As Integer    '処理用カウンタ
    Dim objWks As Object        'シート作成用オブジェクト
    Dim strWks() As String      'シート名格納先

    Dim intLstShtIdx As Integer 'リスト一覧シートのインデックス(位置)
    Dim intLstIdx As Integer    'リスト一覧作成時のインデックス

    Dim strSubAdr As String     'ハイパーリンクのアドレス

    '初期化
    intLstShtIdx = -1

    'シート数取得
    intWksCnt = Excel.ActiveWorkbook.Worksheets.Count
    '格納バッファ定義
    ReDim strWks(intWksCnt)

    'シート数ループ
    For intIdx = 1 To intWksCnt
        strWks(intIdx) = Worksheets(intIdx).Name
        If strWks(intIdx) = LIST_SHEET_NAME Then
            intLstShtIdx = intIdx '一覧表示用シートが存在する
        End If
    Next

    '一覧表示用シートの存在確認
    If intLstShtIdx < 0 Then
        '存在しない：一覧表示用シート追加
        Set objWks = ActiveWorkbook.Worksheets.Add(before:=Worksheets(1))    '先頭に追加
        objWks.Name = LIST_SHEET_NAME
    Else
        'ワークシートオブジェクトをセット
        Set objWks = Worksheets(LIST_SHEET_NAME)
    End If

    objWks.Select
    'リストクリア
    Range(Cells(1, LIST_NO_COLIDX), _
    Cells(intWksCnt, LIST_NAME_COLIDX)).ClearContents

    'リスト一覧インデックスの初期化
    intLstIdx = 0
    For intIdx = 1 To intWksCnt

        'シート一覧の名前は出力しない
        If intLstShtIdx <> intIdx Then
            'リスト一覧インデックスセット
            intLstIdx = intLstIdx + 1

            'セルをセット
            Cells(intLstIdx, LIST_NO_COLIDX) = intLstIdx 'No.
            Cells(intLstIdx, LIST_NAME_COLIDX) = strWks(intIdx) 'Name

            'ハイパーリンクを設定
            strSubAdr = "'" & strWks(intIdx) & "'" & "!A1"      'ハイパーリンクのアドレス
            ActiveSheet.Hyperlinks.Add _
                Anchor:=Cells(intLstIdx, LIST_NAME_COLIDX), _
                Address:="", SubAddress:=strSubAdr, TextToDisplay:=strWks(intIdx)
        End If
    Next

End Sub

補足

所感

大量のシートが存在するワークブックで、各シートへのアクセスを容易にしたくて作成しました。
シートが少なければ単純に移動すれば良いし、あるいはワークシートの左下にあるシート選択の矢印を右クリックして一覧を表示して選択し移動することもできますが、大量になるとそれも操作性が悪く感じます。そんな時にこのVBAマクロを使います。一覧シートになると、チェックシートとしても使えます。

しかし、この一覧シート作成を何度も実行する場合は、一覧の出力行の指定やリストのクリア処理の改善が必要になります、ね。

Windows版をMacで実行した際の修正点

特にありません。