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

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

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

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

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

このマクロでできること

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

文字カウント

マクロの解説

全角の文字数と半角カタカナの文字数を調べるために、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

トップへ戻る