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

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

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

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

文字カウント

部分的に選択をして文字列を数える場合には問題ありません。
(ショートカットキーは、[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

トップへ戻る