【Word VBA】表内の文字数を計算するWordマクロ

2022/10/10 コード 0
, , ,

翻訳者として文字数を計算します。見積や請求の時に必要ですよね。

このときに、表内の文字を正確に計算できないことに気づいたことありませんか？

例えば、こんな感じの表があります。

文字カウント

部分的に選択をして文字列を数える場合には問題ありません。
（ショートカットキーは、[Ctrl] + [Shift] + [G]）

文字カウント

しかし、表のセルをまたいて文字列を選択して、文字カウントをします。

すると。。。

文字カウント

文書全体の文字カウントがされますね。

そこで、表内のセルをまたいで文字列を選択している場合に、正確な文字数を計算するマクロを紹介します。

このマクロでできること

選択した文字列の「単語数」と「文字数（スペースを含めない）」を計算して表示します。

文字カウント

文字列が選択されていない場合には、本文中の「単語数」と「文字数（スペースを含めない）」を計算して表示します。（テキストボックス内の文字列のカウントはしません）

マクロの解説

「文字列が選択されている場合」と「文字列が選択されていない場合」で処理を分けました。

文字列が選択されていない場合には、カーソル位置に限らず、本文中の文字カウントをします。

表内の文字列が選択されている場合には、一度別の処理用の文書を開き、そこに文字列をテキスト形式で貼り付けてから文字数を数えています。

処理用の文書を表示する必要がないので、33行目のように「見えない」設定で開きます。

処理が終わった後は、処理用の文書を閉じます。保存せずに閉じるというメソッドは、44行目で設定します。

文字カウントには、ComputeStatisticsメソッドを使います。Len関数で文字数を求めると、Wordの文字カウント機能で表示される数値と異なりますからご注意ください。

マクロ


Sub 表内の文字カウント()

　Dim myDoc As Document
　Dim cWord As Long　'単語数
　Dim cChar As Long　'文字数（スペースを含めない）
　
　If Selection.Type = wdSelectionIP Then
　　'文字列が選択されていない場合→本文を対象に計算
　　
　　With ActiveDocument.Range
　　　cWord = .ComputeStatistics(wdStatisticWords)
　　　cChar = .ComputeStatistics(wdStatisticCharacters)
　　End With
　　
　Else
　　'文字列が選択されている場合→選択範囲で計算
　　
　　If Selection.Information(wdWithInTable) = False Then
　　　'カーソルが表内にない場合
　　　With Selection.Range
　　　　cWord = .ComputeStatistics(wdStatisticWords)
　　　　cChar = .ComputeStatistics(wdStatisticCharacters)
　　　End With
　　　
　　Else
　　　'カーソルが表内にある場合
　　　
　　　'選択範囲の文字列をコピー
　　　Selection.Copy
　　　DoEvents 'エラー回避のために追加（2014/02/02)
　　　　
　　　'処理用の新規文書を開く（非表示）
　　　Set myDoc = Documents.Add(Visible:=False)
　　　
　　　'クリップボードの内容をテキスト形式で貼り付け
　　　myDoc.Range.PasteSpecial DataType:=wdPasteText
　　　　　
　　　With myDoc.Range
　　　　cWord = .ComputeStatistics(wdStatisticWords)
　　　　cChar = .ComputeStatistics(wdStatisticCharacters)
　　　End With
　　　　　
　　　'処理用の文書を閉じる
　　　myDoc.Close SaveChanges:=wdDoNotSaveChanges
　　　Set myDoc = Nothing
　　
　　End If
　　
　End If
　　
　'文字数と単語数の表示

　MsgBox "単語数" & vbTab & vbTab & vbTab & cWord & vbCr & _
　　　　 "文字数（スペースを含めない）" & vbTab & cChar, _
　　　　 Title:="文字カウント"
　　
End Sub
トップへ戻る