Office関連

蛍光ペンでマークした部分の文字数をカウントするWordマクロ

Twitterでたまたま下記のツイートを見つけたので、簡単な処理を考えてみました。
蛍光ペンでマークした部分の文字数をカウントするWordマクロで、動作確認はWord 2010で行いました。

これ、新田さんマクロに組み込んでくれないかな?(笑)…つか、これくらいなら自分で作れるかww http://bit.ly/PZlnNI 技術者から翻訳者へのシルクロード:MS-WORDファイル上に散在する蛍光ペン部の総文字数を数える方法(WORD2010)

https://twitter.com/terrysaito/status/243093715961405440 より

Option Explicit

Public Sub Sample()
  Debug.Print "文字数 (スペースを含めない) : " & CountHighlightCharacters(ActiveDocument, wdStatisticCharacters)
  Debug.Print "文字数 (スペースを含める) : " & CountHighlightCharacters(ActiveDocument, wdStatisticCharactersWithSpaces)
End Sub

Private Function CountHighlightCharacters(ByVal Doc As Word.Document, ByVal Statistic As Word.WdStatistic) As Long
'蛍光ペンでマークした部分の文字数をカウントする
  Dim r As Word.Range
  Dim n As Long
  
  n = 0 '初期化
  Set r = Doc.Range(0, 0)
  With r.Find
    '※ 検索条件は必要に応じて変更
    .ClearFormatting
    .ClearAllFuzzyOptions
    .Text = ""
    .Replacement.Text = ""
    .Format = True
    .Forward = True
    .Highlight = True
    .MatchAllWordForms = False
    .MatchByte = False
    .MatchCase = False
    .MatchFuzzy = False
    .MatchSoundsLike = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .Wrap = wdFindStop
    Do While .Execute
      n = n + r.ComputeStatistics(Statistic)
    Loop
  End With
  CountHighlightCharacters = n
End Function

DocumentオブジェクトとWdStatistic列挙型を引数にしているので、カウント対象の文書とカウント方法(文字数にスペースを含めるか否か)を指定することができます。

Windows 8にClassic Shellをインストールしてみました。前のページ

Wordマクロで文字数を取得する方法をまとめてみました。次のページ

関連記事

  1. Office関連

    Office 2016関連資料のリンク

    Office 2016関連資料のリンクをメモしておきます。特に「O…

  2. Office関連

    Excel 2016でマップグラフを作成する。

    12月6日、Office Insider向けに、Office 2016…

  3. Office関連

    MicrosoftのDictateアドインを試してみました。

    Microsoftがハンズフリー入力をサポートするOffice用(Wo…

  4. Office関連

    「個人用テンプレートの既定の場所」を設定するWordマクロ

    前回の記事で、Word 2013で個人用テンプレート(カスタム テンプ…

  5. Office アドイン

    [Office用アプリ]辞書アプリを作成する。

    Word 2013で、文字列を選択して校閲タブの文章校正グループから「…

コメント

  1. この記事へのコメントはありません。

Time limit is exhausted. Please reload CAPTCHA.

※本ページはプロモーションが含まれています。

Translate

最近の記事

アーカイブ

PAGE TOP