段落ごとの文字数をカウントしてExcelに出力するWordマクロ

「ワードをエクセルに変換する方法」という検索をもとに、Wordからすべての文をExcelに出力するマクロをご紹介しました。

このマクロがトリガーになったのか、税理士でMicrosoft MVP for Excelの井ノ上陽一さんが
「見出しから次の見出しまでの文字数を出力するWordマクロとかあるといいなぁ。。今書いてる本で項目ごとのページ数が決まっているからその確認に使いたい。」
とツイートしてらっしゃるのに気づきました。

「見出しから次の見出しまでの文字数を」
というときに、見出しの階層がどうなっているのか、どんなスタイルが使われているのかがわからなかったので、とりあえず、汎用性の高いWordマクロを作成してみました。

Wordで上記のマクロを実行すると、A列にページ＆行、B列にその段落の始めの10文字、C列にスタイル名、D列に文字数が出力させたExcelが起動します。

段落のスタイル名と文字数が、見出しから次の見出しまでの文字数を得るために必要な情報ですが、Excelに出力された一覧を見て、Wordのほうでチェックするときの参考情報として、ページ＆行とその段落の始めの10文字も出力しています。

やっていることは以下のとおりです。

まず、段落の数をカウントして
　cnt = ActiveDocument.Paragraphs.Count

二次元配列のサイズを決定しています。
　ReDim arr(1 To cnt, 1 To 4)

その二次元配列に、ループの中でデータを格納していきます。
　For Each par In ActiveDocument.Paragraphs

まずスタイル名を配列の3列目に格納してから、
　With par
　　arr(i, 3) = .Style

ページ番号と行番号を配列の1列目に、
　With .Range
　　arr(i, 1) = "p." & _
　　　.Information(wdActiveEndAdjustedPageNumber) & "-" & _
　　　.Information(wdFirstCharacterLineNumber)

始めの10文字を配列の2列目に、
　　arr(i, 2) = Left(.Text, 10)

段落記号を除いた文字数を配列の4列目に、それぞれ格納しています。
　　arr(i, 4) = Len(Replace(.Text, vbCr, ""))

WordのVBAに慣れていないと、Paragraphオブジェクトから取得するデータと、Rangeオブジェクトから取得するデータがあるというところが、戸惑うポイントかもしれません。

配列にデータを格納したら、ExcelをCreateObjectして
　Set xls = CreateObject("Excel.Application")

ブックを追加して
　.Workbooks.Add

二次元配列に格納したデータを一気に書き出し
　.Range(.Cells(2, "A"), .Cells(cnt + 1, 4)).Value = arr

見出し行を作成して
　.Range("A1").Value = "ページ＆行"
　.Range("B1").Value = "始めの10文字"
　.Range("C1").Value = "スタイル名"
　.Range("D1").Value = "文字数"
　.Range("A1:D1").Font.Bold = True　　
　.Range("A1").CurrentRegion.EntireColumn.AutoFit

Excelを表示しています。
　.Visible = True