Excelのシート一覧を取得する

とある設計書をExcelで作成していたら、シート数がとんでもないことに...。

各シートの作成状況を把握するために、シート一覧を作成しました。

色んな方法があるんですねー。

---

■イミディエイトウィンドウからサクッと取得

とりあえず一覧が欲しいだけなら、この方法が一番楽かなと思います。

1．シート一覧を取得したいブックを開く。

2．Alt + F11 キーを押す → VB 画面が開きます。

3．Ctrl + G キーを押す→ イミディエイトウィンドウが開きます。

4．イミディエイトウィンドウに下記を入力して、ENTER！！

For Each i In ThisWorkbook. Sheets: debug.print i.name : next i

⇒イミディエイトウィンドウにシート一覧が表示されます。

※どうやら、取得(表示)件数に上限があるらしく、末尾200件ほどしか表示されませんでした。

　(シート数が200を超える設計書って、どんな設計書だよ...)

　どこかに設定などあるのかなー？

---

■マクロを組んでファイルに出力

複数ファイルが対象な場合、一覧取得用ブックを用意しマクロを組んで出力するのが良いかも。

ただ、マクロも長い...。

下記のマクロは、指定したフォルダ配下にあるブックのシート一覧を取得します。

Const ROW_DETAIL_START = 1
Const COL_DIR_PATH = 1
Const COL_FILE_NAME = 2
Const COL_SHEET_NAME = 3
Dim listRowIndex As Integer
Dim originDir As String

Sub ボタン1_Click()

    listRowIndex = ROW_DETAIL_START
    Dim ws As Worksheet
    Set ws = Sheets(1)
    Dim parentDir As String
    parentDir = ws.Cells(1, 2)
    originDir = parentDir
    prevDirName = ""
    prevFileName = ""

    Application.ScreenUpdating = False
    ' シート一覧取得実行
    Call execute(parentDir)
    Application.ScreenUpdating = True

    MsgBox "シート一覧を取得しました"

End Sub

Sub execute(parentDir As String)

    Dim buf As String
    buf = Dir(parentDir & Application.PathSeparator & "*" & ".xlsx")
    Do While buf <> ""
        'フォルダ、ファイル名を出力
        Dim ws As Worksheet
        Set ws = Sheets("シート一覧")

        '1ファイルずつ処理
        Call readFile(parentDir & Application.PathSeparator & buf)

        buf = Dir()
    Loop
    Dim f As Object
    With CreateObject("Scripting.FileSystemObject")
        For Each f In .GetFolder(parentDir).subFolders
            execute (f.Path)
        Next f
    End With

End Sub

Sub readFile(filePath As String)
    Dim srcWb As Workbook
    Set srcWb = Workbooks.Open(filePath)
    Dim sheetList() As String
    Dim sheetListSize As Integer
    sheetListSize = 0
    For Each sh In srcWb.Sheets
        ReDim Preserve sheetList(sheetListSize + 1) As String
        sheetList(sheetListSize) = sh.name

        sheetListSize = sheetListSize + 1
    Next sh

    Application.DisplayAlerts = False
    srcWb.Close
    Application.DisplayAlerts = True

    Dim tmpFilePath As String
    tmpFilePath = Replace(filePath, originDir, "")
    Dim spFilePath() As String
    spFilePath = Split(tmpFilePath, Application.PathSeparator)
    Dim fileName As String
    fileName = spFilePath(UBound(spFilePath))
    Dim dirName As String
    dirName = Replace(tmpFilePath, fileName, "")
    Debug.Print tmpFilePath
    ThisWorkbook.Activate

    ' シート一覧に追加する
    Dim destWs As Worksheet
    Set destWs = Sheets("シート一覧")
    For i = 0 To sheetListSize - 1
        With destWs
            .Cells(listRowIndex, COL_DIR_PATH) = dirName
            .Cells(listRowIndex, COL_FILE_NAME) = fileName
            .Cells(listRowIndex, COL_SHEET_NAME) = sheetList(i)
        End With
        listRowIndex = listRowIndex + 1
    Next

End Sub

使い方は...

1．「実行シート」に対象フォルダを指定して、「シート名取得」ボタンをポチッ！

⇒「シート一覧」シートに、ファイル名とシート名がどーん！

　A列：フォルダ名　※「実行シート」で指定したフォルダからの相対パス

　B列：ファイル名

　C列：シート名

---

他にもっといい方法を見付けたら、追記します！