Home » ワードマクロ・Word VBAの使い方 » Office連携 » 段落ごとの文字数をカウントしてExcelに出力するWordマクロ

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

対象:Word2003, Word2007, Word2010

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

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

[スポンサードリンク]

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

▼段落ごとのスタイル名と文字数をExcelに出力するWordマクロ

Sub 段落ごとのスタイル名と文字数をExcelに出力する()

 Dim xls As Object
 Dim par As Paragraph
 Dim cnt As Long   ''段落数
 Dim arr As Variant
 Dim i As Long
 
 cnt = ActiveDocument.Paragraphs.Count
 ReDim arr(1 To cnt, 1 To 4)
 
 i = 1
 For Each par In ActiveDocument.Paragraphs
  With par
   arr(i, 3) = .Style
   With .Range
    arr(i, 1) = "p." & _
     .Information(wdActiveEndAdjustedPageNumber) & "-" & _
     .Information(wdFirstCharacterLineNumber)
    arr(i, 2) = Left(.Text, 10)        ''始めの10文字
    arr(i, 4) = Len(Replace(.Text, vbCr, "")) ''段落記号を除いた文字数
   End With
  End With
  i = i + 1
 Next
 
 Set xls = CreateObject("Excel.Application")
 With xls
  .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
  .Visible = True
 End With
 Set xls = Nothing

End Sub

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

関連語句
VBA, Visual Basic for Applications

[スポンサードリンク]

Home » ワードマクロ・Word VBAの使い方 » Office連携 » 段落ごとの文字数をカウントしてExcelに出力するWordマクロ

「Office連携」の記事一覧

検索


Copyright © インストラクターのネタ帳 All Rights Reserved.

.