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の新製品発売記念イベントに参加してきました。

    今月16日に開催された、Officeの新しい製品の発売記念イベント「平…

  2. Office関連

    Adobe Readerを利用してPDFファイルのページ数を取得するVBAマクロ

    mougの回答用に書いたコードです。mougは半年でログが消えてし…

  3. Office関連

    Office 365 APIをVBAから呼び出す(3)

    前々回の記事でOffice 365とAzure ADの紐づけを、前回の…

  4. Windows 10

    【2017年1月版】Microsoft Edgeを操作するVBAマクロ(DOM編)(2)

    昨日の記事で、Microsoft Edgeを操作するVBAコードを改め…

  5. Office関連

    「Excel VBAでラクラク Win64 APIプログラミング」(大村あつし著)レビュー

    当ブログでも以前書評を書いた「Excel VBAの神様 ボクの人生を変…

  6. アイコン一覧

    Office 365アイコン(imageMso)一覧(S)

    Office 365のデスクトップ版Officeアプリケーション(Wo…

コメント

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

Time limit is exhausted. Please reload CAPTCHA.

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

Translate

最近の記事

アーカイブ

PAGE TOP