Excel VBA: シート名から目次を自動生成する

Excelで仕様書・設計書を書いているエンジニアは、相当数にのぼると考えられます。タイトルページ、変更履歴、目次、インタフェース、アーキテクチャ、機能一覧、、、。目次なんて、勝手に作ってほしいですよね。ねっ。WORDなら、できるんだし。


今回はそんなとき役に立つ以下のトピックについて、書いてみたいと思います：

1. 各シートに、ページ・タイトルを設定する


2. ページ・タイトルの一覧をリスト・アップし、目次を自動生成する

このとき、目次のページ・タイトルをクリックすると、当該ページにジャンプする

1. 各シートにページ・タイトルを設定する

今回は、以下のような仕様でいこうと思います：

• ページ・タイトルは、シート名と同一とする
• 各シートのA1セルに、ページ・タイトルを表示する
  当然、シート名を変えたときは自動的に追随するものとします。
• また各シートへのタイトル設定は、自動でできる

これらは、以下のようなコードで、実現できます：

'name: insert_titles
'date: May 28th, 2008
'author: http://voidptr.seesaa.net/
'desc: 各シートにタイトルを設定する
'
'
Public Sub insert_titles()
Dim ii As Integer

For ii = 1 To ThisWorkbook.Sheets.Count
ThisWorkbook.Sheets(ii).Range("A1").Value _
= "=RIGHT(CELL(" & """" _
& "filename" & """" _
& ",A1), LEN(CELL(" & """" _
& "filename" & """" _
& ",A1))-FIND(" & """" _
& "]" & """" _
& ", CELL(" & """" _
& "filename" & """" _
& ",A1)))"
Next ii
End Sub

シートごとに、A1セルの値を設定しているだけです。

シート名は、Excelの関数cell()から得ています。

ただしcell("filename",A1)だけでは、

フルパス＋[xlsファイル名]＋シート名

のかたちであるため、シート名の部分だけRＩＧHT()、LEN()、FIND() で切り取っています。

cell関数を使用しているため、シート名を変更したときは、自動的にタイトルも変わります。


ちょっとわかりにくい点として、ダブル・クォート（”）が４つ、連続して書かれている箇所があります。
これは、文字列としてのダブル・クォートです。

　　

2. 目次を自動生成する

ここでは、以下のような仕様で行こうと思います。

• 目次のページのシート名は、「目次」または「Contents」とする
• 目次ページより左側にあるシート、および目次ページ自体は、目次に含めない
• 目次ページには、名前付セル：TITLE_LISTNIG を用意し、このセルから下に向かってページ・タイトルを羅列していく
• 羅列されたページ・タイトルをクリックすると、そのシートにとぶ

これらは、以下のようなコードで実現されます。

'name: make_contents
'date: May 28th, 2008
'author: http://voidptr.seesaa.net/
'desc: 目次をつくる
'
Public Sub make_contents()
'
Const PAGE_TITLE = "A1"
Const START_LISTING = "TITLE_LISTING"

'
Dim is_after_contents As Boolean
Dim num_sheets As Integer
Dim num_skips As Integer
Dim ii As Integer

is_after_contents = False
num_sheets = ThisWorkbook.Sheets.Count
num_skips = 1

''' list the title pages.
For ii = 1 To num_sheets
'clear old list item.
Range(START_LISTING).Offset(ii).Value = ""


'count the pages before contents.
If is_after_contents = False Then
num_skips = num_skips + 1
End If


'list a item.
If ThisWorkbook.Sheets(ii).Name = "目次" _
Or ThisWorkbook.Sheets(ii).Name = "Contents" _
Then

is_after_contents = True

Else
If is_after_contents Then
Range(START_LISTING).Offset(ii - num_skips).Value _
= "=hyperlink(" _
& """" & "#" _
& "'" _
& ThisWorkbook.Sheets(ii).Range(PAGE_TITLE).Value _
& "'" _
& "!A1" _
& """" _
& "," _
& """" _
& ThisWorkbook.Sheets(ii).Range(PAGE_TITLE).Value _
& """" _
& ")"
End If
End If

Next ii

End Sub

注意としては、セルの名前：TITLE_LISTINGは自分で定義すること。


このマクロを実行すると、目次シートのTITLE_LISTINGセルから下に向かって、ページ・タイトルがずらっと表示されると思います。
各ページ・タイトルは、HYPERLINK関数を利用して表示されているので、クリックすると、実際のページに飛びます。



わかりにくい点として、ダブル・クォートでかこまれたシングルクォートがあると思います。これはなぜ必要か？

シート名によっては、参照がうまくできなくなる場合があるからです。（ハイフンを含んだシート名＝ページ・タイトルで試してみて。）
HYPERLINK関数の仕様です。



お好みで、この目次ページに「更新」ボタンなどを定義し、押下したらmake_contents（）が実行されるようにしたらよいでしょう。