全シート一覧をハイパーリンク付きで作成する
Excelのブックでシートの数が増えてきたときなどに、シートの一覧を取得したいことがあります。一覧の各シート名にはハイパーリンクが設定されてあると便利です。
以下のマクロはそういうときに利用するマクロです。
ソースコード
|
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 |
Sub GetSheetList() Dim sht As Worksheet '// シート Dim bHiddenExistFlg As Boolean '// 非表示シート存在判定(True：非表示シートあり、False：なし) Dim i '// index（行） '// 一番左にシートを追加 Sheets.Add before:=Sheets(1) '// シート一覧シートの名前を設定。重複が無いように日時文字列を付与 ActiveSheet.Name = "シート一覧" & Format(Now, "yyyymmdd-hhmmss") '// 初期値設定：非表示シートは無し bHiddenExistFlg = False i = 0 '// 全シートループ For Each sht In Sheets '// シート名を出力 ActiveCell.Offset(i, 0).NumberFormatLocal = "@" ActiveCell.Offset(i, 0).Value = sht.Name Debug.Print sht.Name '// シートへのハイパーリンクを設定 ActiveSheet.Hyperlinks.Add Anchor:=ActiveCell.Offset(i, 0), Address:="", SubAddress:="'" & sht.Name & "'!A1", TextToDisplay:=sht.Name '// 非表示シートの場合 If (sht.Visible = xlSheetHidden) Or (sht.Visible = xlSheetVeryHidden) Then '// 背景色を付ける ActiveCell.Offset(i, 0).Interior.ColorIndex = 15 bHiddenExistFlg = True End If i = i + 1 Next '// 非表示シートがある場合 If (bHiddenExistFlg = True) Then Call MsgBox("非表示シートあり（灰色背景）", vbOKOnly) End If End Sub |
ソースコードの説明
ブックの一番左に新規シートを追加し、そのシートのA1セルから順に下に向かってシート名を出力します。出力の際にそのシートへのハイパーリンクを設定します。
イミディエイトウインドウにも同様に出力します。
非表示シートの場合はシート名を出力する際に背景色を付けるようにしています。この処理は無くても構いません。
全シートのループ処理中に非表示シートがあった場合は、ループ終了後に非表示シートがあることをメッセージボックス表示します。この処理もなくても構いません。
使い方
上記ソースコードのマクロの使い方ですが、シートの一覧を出力したいブックを表示してGetSheetList関数を実行するだけです。
例として以下のようなシートがあるとします。
そして上のGetSheetList関数を実行します。
以下のように処理日時のシートが追加されてハイパーリンク状態のシート一覧が出力されます。
