bar_1

contents_map

2008年5月28日水曜日

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

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


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


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

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

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





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ファイル名]+シート名

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

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


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

  

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()が実行されるようにしたらよいでしょう。





0 件のコメント:

コメントを投稿

何かありましたら、どうぞ: