ブックのシート名を取得して一覧表を作成するエクセルVBA

ブックにあるシート名を取得して一覧表を作成するエクセルVBAをご紹介します。

次のサンプルコードを使うと、

• 「ファイルを開く」ダイアログを表示。
• シート名を取得したいエクセルブックを選択。
• 選択したエクセルブックに、「シート名一覧」シートを追加。
• エクセルブックに含まれる全シート名を取得、「シート名一覧」にシート名の一覧表を作成する。

という作業を自動化します。

操作方法

1、 下記サンプルコードを含むエクセルファイルを開き→「開発」→「マクロ」の順でクリック。 「Aシート名取得」→「実行」の順でクリック。

2、
ファイルを開くダイアログが表示されるので、シート名を取得したい対象のエクセルブックをクリックして、「開く」をクリック。

3、
マクロが実行されます。
「シート名一覧」を追加、全シート名を取得して、
「シート名一覧」にシート名の一覧表を作成します。

完了です。

サンプルコード

Sub Aファイルを開く()
    Dim OpenFileName As String
OpenFileName = Application.GetOpenFilename("Excelファイル,*.xls*")

If OpenFileName = "False" Then
    
    MsgBox "キャンセルされました。処理を終了します。"
    
    End
    
Else
    Workbooks.Open OpenFileName

End If

End Sub
Sub Aシート名取得()
Dim sh As Variant, flag As Boolean
Dim ws As Worksheet
Dim i As Long
i = 0
Call Aファイルを開く


'画面更新停止
Application.ScreenUpdating = False

'確認ダイアログ停止
Application.DisplayAlerts = False

For Each sh In Sheets
    If sh.Name = "シート名一覧" Then
        flag = True
        Exit For
    End If
Next sh

If flag = True Then

    Dim rc As Integer
    
    'メッセージ表示
    rc = MsgBox("シート「シート名一覧」を上書きしますか？" & Chr(13) & "※この処理は戻せません", vbYesNo + vbQuestion, "確認")
    
    If rc = vbYes Then
        '画面更新停止
        Application.ScreenUpdating = False
        
        'シート選択
        Worksheets("シート名一覧").Activate
    
        'シート削除
        ActiveSheet.Delete

        '画面更新停止
        Application.ScreenUpdating = True
        
        'メッセージ表示
        MsgBox "処理前のシート「シート名一覧」は削除済みです"
        
        'シート追加
        Worksheets.Add before:=Worksheets(1)
        
        'シート名変更
        ActiveSheet.Name = "シート名一覧"

        'シート選択
        Worksheets("シート名一覧").Activate

        Worksheets("シート名一覧").Activate
        Worksheets("シート名一覧").Range("A1").Value = "シート名（現在）"
        Worksheets("シート名一覧").Range("B1").Value = "シート名（変更後）"
        
        For Each ws In Worksheets
            Cells(Selection.row + i, Selection.Column).NumberFormatLocal = "@"
            Cells(Selection.row + i, Selection.Column) = ws.Name
            i = i + 1
        Next
        
        ActiveSheet.Name = "シート名一覧"
        Columns("A:B").Select
        Columns("A:B").EntireColumn.AutoFit
        Selection.NumberFormatLocal = "@"
        
    Else
        
        'メッセージ表示
        MsgBox "キャンセルされました。処理を終了します。"
    
    End If
    
Else

    'シート追加
    Worksheets.Add before:=Worksheets(1)
    
    'シート名変更
    ActiveSheet.Name = "シート名一覧"

    'シート選択
    Worksheets("シート名一覧").Activate

    Worksheets("シート名一覧").Activate
    Worksheets("シート名一覧").Range("A1").Value = "シート名（現在）"
    Worksheets("シート名一覧").Range("B1").Value = "シート名（変更後）"
    
    For Each ws In Worksheets
        Cells(Selection.row + i, Selection.Column).NumberFormatLocal = "@"
        Cells(Selection.row + i, Selection.Column) = ws.Name
        i = i + 1
    Next
    
    ActiveSheet.Name = "シート名一覧"
    Columns("A:B").Select
    Columns("A:B").EntireColumn.AutoFit
    Selection.NumberFormatLocal = "@"
    
End If

End Sub

 

コードの特徴

• 「ファイルを開く」ダイアログを表示した後、キャンセルをクリックした場合、 キャンセル処理される様に対応しています。
• 「ブックのシート名を一括で置換するエクセルVBA」と連携可能な様にしています。