開いているWordファイルのブックマーク名一覧を作成するExcelマクロ

アクティブな文書から新しいExcelブックに「ブックマーク名・ページ番号・行番号」の一覧を作成するWordマクロをご紹介しました。

Wordマクロではなく、Excelマクロにしておくという考え方もあるでしょう。

Wordマクロの場合は新しいExcelファイルにブックマーク名一覧を作成しましたが、Excelマクロの場合は、ブックマーク名一覧を作成するワークシートを決めておいて、ブックマーク一覧を作り直すほうが、便利そうに思えます。

ブックマークの存在するWordファイルをどう指定するについても、いくつかの実装方法が考えられますが、このあとにブックマークの削除作業が続くことをイメージすると、ブックマークの存在しているWordファイルを事前に開いておいてからブックマーク一覧を作り直すという仕様が良さそうです。

開いているWordファイルからブックマーク一覧を作成するサンプルマクロ

ブックマークの含まれているWordファイルが開かれている状態で、以下のマクロを実行すると、アクティブなワークシートにブックマーク名等の一覧が作られます。

サンプルマクロの解説

既存のワークシートを上書きしてしまうので、このマクロでは、はじめに確認を行っています。
　If MsgBox("アクティブなシートのブックマーク名一覧を作り直しますか？", vbYesNo) = vbNo Then Exit Sub

開かれているWordファイルから、
　Set wrd = GetObject(Class:="Word.Application")
　With wrd.Documents(1)

文書名を変数・doc_nameに格納後、
　　doc_name = .Name

ブックマークの数を取得して2次元配列のサイズを決めて、
　　With .Bookmarks
　　　cnt = .Count
　　　ReDim arr(1 To cnt, 1 To 3)

For～Nextループを回しながら、
　　　For i = 1 To cnt

ブックマーク名・ページ番号・行番号を格納しています。
　　　　With .Item(i)
　　　　　arr(i, 1) = .Name
　　　　　With .Range
　　　　　　arr(i, 2) = _
　　　　　　　　.Information(wdActiveEndAdjustedPageNumber)
　　　　　　arr(i, 3) = _
　　　　　　　　.Information(wdFirstCharacterLineNumber)

アクティブなシートを一旦クリアしてから、
　Range("A1").CurrentRegion.Clear

A1セルにWordのファイル名、
　Range("A1").Value = doc_name

A2:C2セルに見出しを入力して、
　Range("A2").Value = "ブックマーク名"
　Range("B2").Value = "ページ番号"
　Range("C2").Value = "行番号"

ブックマーク名・ページ番号・行番頭を一気に書き出して、
　Range(Cells(3, "A"), Cells(cnt + 2, "C")).Value = arr()

ワークシートの体裁を整えています。
　Range("A1:C2").Font.Bold = True
　Range("A1").CurrentRegion.EntireColumn.AutoFit

実行時エラーの発生する可能性がいろいろと考えられますが、ここでは最低限のエラートラップだけを入れておきました。
　On Error GoTo ERR_HNDL
ERR_HNDL:
　MsgBox "エラーが発生しました。"
　Err.Clear

Wordへの参照設定が行われていないことを前提に、以下の定数宣言をプロシージャ内で行っていますが、参照設定されている場合は不要です。
　Const wdActiveEndAdjustedPageNumber = 1
　Const wdFirstCharacterLineNumber = 10