見出しごとにジャンプするマクロ

Wordのスタイル機能は有名なのですが、Excelにもスタイル機能があって、Wordと同じように見出しスタイルとして目立つような書式にすることができます。

ホームタブの中にセルのスタイルがあって、これで複数のセルに見出しスタイルに設定しておけば、そのスタイルの書式を変えただけで、設定したすべてのセルの書式が変わるという、使えば便利な機能なのです。

しかし、Wordのようにこの見出しを使って目次のようなことをすることはできなくて、Excelのスタイルはただ書式を設定するだけに留まってしまう機能なのであまり使う機会もないのかもしれません。

そこで、次のような動きをする機能を追加できれば便利になるなと思いました。

一行目から3行目までウィンドウ枠の固定をしています。

Nextのボタンを押すと、その最初に表示された行の次の行から使用セルの最終行までを上から探していって、その中に「見出し」スタイルがあったらそこを最初の表示行にします。

Topのボタンを押すと、1行目から下に使用セルの最終行までを上から探していって、初めて見つかった見出しスタイルにジャンプします。

もし、今表示されている行が上から見てはじめての見出しスタイルならばTopのボタンの高さを小さくします。

もし、今表示されている行から仕様セルの最終行まで、上から見て見出しスタイルが無ければNextのボタンの高さを小さくします。

そのVBAが次のコードです。

Sub 見出し検索(btn)
  Dim sh As Worksheet
  Dim r As Long
  Dim firstr As Long
  Dim nextr As Boolean
  Set sh = ActiveSheet
  If btn = "next" Then
    For r = ActiveWindow.VisibleRange(1).Row + 1 To Range("A1").SpecialCells(xlLastCell).Row
      If Cells(r, "A").Style Like "*見出し*" Then
        ActiveWindow.ScrollRow = r
        Exit For
      End If
    Next
  ElseIf btn = "top" Then
    For r = 1 To Range("A1").SpecialCells(xlLastCell).Row
      If Cells(r, "A").Style Like "*見出し*" Then
        firstr = r
        ActiveWindow.ScrollRow = r
        Exit For
      End If
    Next
  End If
  If firstr <> ActiveWindow.VisibleRange(1).Row Then
    sh.Shapes("top").Height = 18
  Else
    sh.Shapes("top").Height = 5
  End If
  nextr = False
  For r = ActiveWindow.VisibleRange(1).Row + 1 To Range("A1").SpecialCells(xlLastCell).Row
    If Cells(r, "A").Style Like "*見出し*" Then
      nextr = True
      Exit For
    End If
  Next
  If nextr Then
    sh.Shapes("next").Height = 18
  Else
    sh.Shapes("next").Height = 5
  End If
End Sub

Topの図形をクリックして、リボンに表示される図形の書式タブをクリックしてオブジェクトの選択と表示ボタンをクリックして図形の名前をtopにします。同様にNextの図形の名前をnextにします。

Nextの図形とTopの図形にマクロを登録するのですが、マクロは引数が必要なので、次の記事の操作でマクロを登録します。

図形にマクロの登録をするときの引数の設定