Excelを使っている時、一つのブックにたくさんのシートを作成する場面って結構ありませんか?
そんな時、目次シートがあったら便利ですよね。
でも、シートの数が多いと目的のシートに次々と移動したい時、いちいち大抵一番左側にある目次シートに戻ってくるのって結構めんどくさくないですか?
そんな時は、各シートに目次シートへのリンクを作っておけば、相互にマウスクリックでジャンプするだけなのでメチャメチャ作業が楽になります。
その一連の操作を一発で行い、目次と各シートをリンクするマクロを作成してみました。シートの数が極端に多い場合は役に立つはずです。
百聞は一見に如かず、一目瞭然、一発でイメージが湧き、使い方がわかるようなGIFアニメ付きです。
ぜひ、コピーしてご活用ください。
目次と各リンクをシート内で相互にハイパーリンクでジャンプしたい
たくさんのシートを作成した時、目次があると大変便利です。
一瞬で目次を作成して各シートにジャンプでき、そのジャンプ先のシートからも目次に一瞬で戻ってきたい場面って結構ありませんか?
そんな方達向けにまぁまぁ汎用的なマクロを作ってみました。
VBAマクロの操作イメージサンプル例
マクロを登録して、下記の画像操作と同じようにやってみてください。
ページ番号+シート名
シート数が一発でわかるシートの順番に並べたページ番号付きです。シートの順番を変えて再度実行すれば番号も再整理されます。
目次リンクの折り返し制御
快適に目次からサクサクと各シートにジャンプするためには、目次シートは一発で全シートが見える状態がベストですよね。
単純に1列のみのリスト出力だと、100シートを超える場合はいちいちスクロールする手間が発生してしまいます。
柔軟に複数列で目次リストを作成できるように折り返し制御を盛り込みました。
用途に合わせて定義を変更し、微調整してください。
目次シートリンク作成VBAマクロの主な仕様
細かい処理はコメントで補足してるので、ザックリとした仕様を箇条書きで記載します。
- ブック内の全シートにリンクするリストを表示した目次シートを作成
- ブック内の各シートに目次シートへのリンクを作成
- 実行判断の確認メッセージ制御(フラグon/offあり)
- 目次リストが1ページ内に収まるように折り返し制御
- 目次シートへのリンクはセルだと既存の値を上書きしてしまうため、テキストボックスで作成 ※既に存在していた場合は削除
目次シートリンク作成VBAマクロのソースコード
目次ジャンプ効率を爆上げしたい方は、下記のソースコードを以下↓↓↓のリンクの内容に従って個人用マクロにコピーしてご使用ください。
マクロならば、痒いところに手が届きます。用途によっては目的に沿わない可能性がありますが、Const値を持たせてなるべく汎用的に作成しています。
自分に合った方法にカスタマイズしてみてください。VBAマクロの勉強にも少しは役立つと思います。
Sub 目次シート作成()
Const 確認メッセージフラグ = 1 '0:確認メッセージを表示しない、1:確認メッセージを表示する
Const 処理区分 = 1
'0:目次シートのみ作成(各シート目次リンクがある場合は削除)
'1:目次シート作成+各シート目次リンク作成
'''''目次シート定数'''''
Const 目次シート名 = "目次"
Const 目次リスト折り返し行数 = 10
Const 目次リスト折り返し列数 = 3
Const 目次リスト行マージン = 3 '上余白
Const 目次リスト列マージン = 1 '左余白
'''''各シート定数'''''
Const 各シート目次リンク名 = 目次シート名 & "へ"
Const 各シート目次リンク左端位置 = 750
Const 各シート目次リンク上端位置 = 0
Call 目次シートと各シート右上に目次リンク作成処理(確認メッセージフラグ, _
目次シート名, _
目次リスト折り返し行数, _
目次リスト折り返し列数, _
目次リスト行マージン, _
目次リスト列マージン, _
各シート目次リンク名, _
各シート目次リンク左端位置, _
各シート目次リンク上端位置, _
処理区分)
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub 目次シートと各シート右上に目次リンク作成処理(確認メッセージフラグ As Integer, _
目次シート名 As String, _
目次リスト折り返し行数 As Integer, _
目次リスト折り返し列数 As Integer, _
目次リスト行マージン As Integer, _
目次リスト列マージン As Integer, _
各シート目次リンク名 As String, _
各シート目次リンク左端位置 As Long, _
各シート目次リンク上端位置 As Long, _
処理区分 As Integer)
''''''''''概要''''''''''
'ブック内の全シートにリンクするリストを表示した目次シートを作成
'ブック内の各シートに目次シートへのリンクを作成
''''''''''定義''''''''''
'''''共通変数'''''
Dim メッセージ As String
Dim 実行確認 As Integer
'''''目次シートワーク変数'''''
Dim 目次シート As Object
Dim シートSEQ, 各シート番号, 行SEQ, 列SEQ, 目次リスト行, 目次リスト列 As Integer
Dim 目次シート存在チェックフラグ As Integer
Dim 目次シートセル As Range
'''''各シートワーク変数'''''
Dim 各シート As Worksheet
Dim 各シート名 As String
Dim 各シートアドレスリンク As String
Dim 各シート目次アドレスリンク
Dim テキストボックス As Object
''''''''''高速化''''''''''
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
''''''''''確認処理''''''''''
If 確認メッセージフラグ = 1 Then
If 処理区分 = 0 Then
メッセージ = メッセージ & "<目次シートのみ作成>" & vbCrLf
ElseIf 処理区分 = 1 Then
メッセージ = メッセージ & "<目次シート作成+各シート目次リンク作成>" & vbCrLf
End If
メッセージ = メッセージ & vbCrLf
メッセージ = メッセージ _
& "・目次シートに各シートへリンクする目次リストを作成します。" & vbCrLf _
& "・目次シートが存在しない場合は新規シートを作成します。" & vbCrLf _
& "・既に目次シートが存在する場合は一旦クリア後に再作成します。" & vbCrLf _
& "・シート数「" & 目次リスト折り返し行数 & "」行で次列に折り返します。" & vbCrLf
If 処理区分 = 0 Then
メッセージ = メッセージ _
& "・各シートに目次シートへのリンク(テキストボックス)「" & 各シート目次リンク名 & "」が存在する場合は全て削除します。" & vbCrLf _
& " ※各シートの目次リンクは作成しません。" & vbCrLf _
& " (全シートに誤って作成してしまったリンクを削除する場合に有効)" & vbCrLf
ElseIf 処理区分 = 1 Then
メッセージ = メッセージ _
& "・各シートに目次シートへのリンク(テキストボックス)「" & 各シート目次リンク名 & "」を作成します。" & vbCrLf _
& " ※既に存在する場合は一旦削除後に再作成します。" & vbCrLf _
& " (目次シートと各シートを相互にリンクしたい場合に有効)" & vbCrLf
End If
'実行確認
If メッセージ <> "" Then
実行確認 = MsgBox(メッセージ & vbCrLf _
& "実行してよろしいですか?", vbYesNo + vbQuestion)
If 実行確認 = vbNo Then Exit Sub
End If
End If
''''''''''チェック''''''''''
If 目次リスト折り返し列数 < 2 Then
MsgBox "番号とリンクで最低2列必要なので、折り返し列数は「2」以上を設定してください。" & vbCrLf _
& "処理を終了します。"
Exit Sub
End If
目次シート存在チェックフラグ = 0
For Each 各シート In Worksheets
If 各シート.name = 目次シート名 Then
目次シート存在チェックフラグ = 1
Exit For
End If
Next
'''''目次シート作成'''''
'シートが存在しない場合は「目次」シートを先頭に新規作成
If 目次シート存在チェックフラグ = 0 Then
Worksheets.Add Before:=Worksheets(1)
Worksheets(1).name = 目次シート名
End If
''''''''''目次シートに各シートリンク作成''''''''''
Set 目次シート = Worksheets(目次シート名)
'全セルクリア(数式、文字列をクリアして初期化)※書式や幅などはクリアされない
目次シート.cells.ClearContents
'各シート分ループ(目次シートは除外)
シートSEQ = 0
For 各シート番号 = 1 To Worksheets.Count
Set 各シート = Worksheets(各シート番号)
If 各シート.name <> 目次シート名 Then
'行と列の折り返し位置を算出するためのシーケンス
'(例えば、折り返し行数が"5"の時、1-5番目のシートは列SEQ"1"、6-10番目は列SEQ"2"、…)
行SEQ = シートSEQ Mod 目次リスト折り返し行数 + 1
列SEQ = シートSEQ \ 目次リスト折り返し行数 + 1
シートSEQ = シートSEQ + 1
'目次リストの各シートリンク設定位置
目次リスト行 = 目次リスト行マージン + 行SEQ
目次リスト列 = 目次リスト列マージン + (列SEQ - 1) * 目次リスト折り返し列数 + 1
'''''シート番号設定'''''
目次シート.cells(目次リスト行, 目次リスト列).Value = シートSEQ
'''''各シート名とリンク設定'''''
Set 目次シートセル = 目次シート.cells(目次リスト行, 目次リスト列 + 1)
各シート名 = 各シート.name
目次シートセル.FormulaR1C1 = 各シート名
各シートアドレスリンク = "'" & 各シート名 & "'" & "!A1"
'ハイパーリンクを挿入
目次シート.Hyperlinks.Add Anchor:=目次シートセル, Address:="", SubAddress:=各シートアドレスリンク
''''''''''各シートに目次シートリンク作成''''''''''
各シート.Activate
'既に目次シートリンクが存在しているかチェック
For Each テキストボックス In 各シート.Shapes
'テキスト値が目次リンク名のテキストボックスオブジェクト(msoTextBox:17)が存在する場合は全て削除
If テキストボックス.Type = msoTextBox And _
テキストボックス.TextFrame.Characters.Text = 各シート目次リンク名 Then
テキストボックス.Delete
End If
Next
'各シート目次リンク作成
If 処理区分 = 1 Then
各シート目次アドレスリンク = "'" & 目次シート名 & "'" & "!A1"
'テキストオブジェクトの目次シートへのリンクを各シートの右上あたり(推奨)に作成
各シート.Shapes.AddTextbox(msoTextOrientationHorizontal, 各シート目次リンク左端位置, 各シート目次リンク上端位置, 0, 0).Select
With Selection.ShapeRange
.TextFrame2.TextRange.Characters.Text = 各シート目次リンク名
.TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(0, 0, 255) 'フォント色:青
.TextFrame2.TextRange.Font.UnderlineStyle = msoUnderlineSingleLine '下線
.Fill.ForeColor.RGB = RGB(255, 255, 255) '背景色:白
.TextFrame.AutoSize = True '自動調整
.Line.Visible = False '線なし
各シート.Hyperlinks.Add Anchor:=.Item(1), Address:="", SubAddress:=各シート目次アドレスリンク
.TextFrame2.TextRange.Characters.Font.name = "MS Pゴシック"
End With
Selection.Placement = xlFreeFloating 'セルに合わせて移動やサイズ変更をしない
'先頭セルへ移動(最上部へのスクロールも行う)
各シート.Range("A1").Select
Application.GoTo Reference:=ActiveCell, Scroll:=True
End If
End If
Next
'目次シートアクティブ
目次シート.Activate
'列幅自動調整
目次シート.cells.EntireColumn.AutoFit
'目次タイトル設定
If 目次リスト行マージン > 2 Then 'マージン不足の場合は設定しない
目次シート.cells(目次リスト行マージン - 1, 目次リスト列マージン + 1).Value = 目次シート名
目次シート.cells(目次リスト行マージン - 1, 目次リスト列マージン + 1).Font.Bold = True
End If
目次シート.Range("A1").Select
finally:
'''''''''''高速化''''''''''
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
End Sub
目次シートリンク作成マクロのGASとExcelVBAとの違い
GAS版はコチラ。
仕様、ロジックはほとんど同じです。
ExcelからGoogleスプレッドシートに徐々にでも移行を考えている方は見比べて参考にしてみてください。
最後に
Excelの使い方は人それぞれ、いろんなやり方があると思いますが、一例としてご紹介させていただきました。
ExcelVBAマクロはちょっとした向上心さえあれば、取っ付きやすいプログラムなのでショートカットキーなどと組み合わせてぜひ活用してみてください。
Excel全ショートカットキー一覧はこちら↓↓↓
ちょっと工夫すれば、ちょっとした操作に1分かかっていた作業を10秒でこなすことができるようになる可能性があります。
それだけでも、積み上げれば相当の工数を削減できるはずなので、ぜひ自分に合ったやり方を模索していきましょう。
コメント