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

2014年2月4日

, ,

先日の「表内の文字数を計算する 」の続きです。

上記の記事では、表内の文字数や単語数を正確に表示させました。

項目は「単語数」と「文字数（スペースを含めない）」でした。

このマクロへご要望をいただきましたので、少しつくりかえます。今回のマクロでは、上記項目に加え、「半角英数の単語数」と「全角文字＋半角カタカナの数」を表示させます。

このマクロでできること

表内の文字列を部分的に選択して文字カウントをしても、正確に数えます。

文字カウント

マクロの解説

全角の文字数と半角カタカナの文字数を調べるために、27行目でアジア言語の文字数を数えます。

半角英数の単語数は、28行目のように「単語数」から「全角文字＋半角カタカナの数」を除いて求めます。

記述は冗長になってしまいました。文字数や単語数を数える別のモジュールを作った方がすっきりしますね。

マクロ


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

　Dim myDoc As Document
　Dim cChar As Long　'文字数（スペースを含めない）
　Dim cWord As Long　'単語数
　Dim cZenChar As Long '文字数（全角文字 ＋ 半角カタカナ）
　Dim cHanWord As Long '単語数（半角英数）
　
　If Selection.Type = wdSelectionIP Then
　　'文字列が選択されていない場合→文書全体で計算
　　
　　With ActiveDocument.Range
　　　cWord = .ComputeStatistics(wdStatisticWords)
　　　cChar = .ComputeStatistics(wdStatisticCharacters)
　　　cZenChar = .ComputeStatistics(wdStatisticFarEastCharacters)
　　　cHanWord = cWord - cZenChar
　　End With
　　
　Else
　　'文字列が選択されている場合→選択範囲で計算
　　
　　If Selection.Information(wdWithInTable) = False Then
　　　'カーソルが表内にない場合
　　　With Selection.Range
　　　　cWord = .ComputeStatistics(wdStatisticWords)
　　　　cChar = .ComputeStatistics(wdStatisticCharacters)
　　　　cZenChar = .ComputeStatistics(wdStatisticFarEastCharacters)
　　　　cHanWord = cWord - cZenChar
　　　End With
　　　
　　Else
　　　'カーソルが表内にある場合
　　　
　　　'選択範囲の文字列をコピー
　　　Selection.Copy
　　　　
　　　'処理用の新規文書を開く（非表示）
　　　Set myDoc = Documents.Add(Visible:=False)
　　　
　　　'クリップボードの内容をテキスト形式で貼り付け
　　　myDoc.Range.PasteSpecial DataType:=wdPasteText
　　　　　
　　　With myDoc.Range
　　　　cWord = .ComputeStatistics(wdStatisticWords)
　　　　cChar = .ComputeStatistics(wdStatisticCharacters)
　　　　cZenChar = .ComputeStatistics(wdStatisticFarEastCharacters)
　　　　cHanWord = cWord - cZenChar
　　　End With
　　　　　
　　　'処理用の文書を閉じる
　　　myDoc.Close SaveChanges:=wdDoNotSaveChanges
　　　Set myDoc = Nothing
　　
　　End If
　　
　End If
　　
　'文字数と単語数の表示
　MsgBox "単語数" & vbTab & vbTab & vbTab & cWord & vbCr & _
　　　　 "文字数（スペースを含めない）" & vbTab & cChar & vbCr & _
　　　　 "半角英数の単語数" & vbTab & vbTab & cHanWord & vbCr & _
　　　　 "全角文字 ＋ 半角カタカナの数" & vbTab & cZenChar, _
　　　　 Title:="文字カウント"
　　
End Sub

 

-コード
-, ,