次のサンプルコードを使うと、
- 「ファイルを開く」ダイアログを表示。
- シート名を取得したいエクセルブックを選択。
- 選択したエクセルブックに、「シート名一覧」シートを追加。
- エクセルブックに含まれる全シート名を取得、「シート名一覧」にシート名の一覧表を作成する。
という作業を自動化します。
目次
操作方法
1、
下記サンプルコードを含むエクセルファイルを開き→「開発」→「マクロ」の順でクリック。
「Aシート名取得」→「実行」の順でクリック。
2、
ファイルを開くダイアログが表示されるので、シート名を取得したい対象のエクセルブックをクリックして、「開く」をクリック。
3、
マクロが実行されます。
「シート名一覧」を追加、全シート名を取得して、
「シート名一覧」にシート名の一覧表を作成します。
完了です。
サンプルコード
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 | 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」と連携可能な様にしています。
