【Word】1桁の数字は全角に、2桁以上の数字は半角に【VBA】

以前書いた記事の続きというか同じ内容ですが、今回はExcelでなくWordです。

私は社会保険労務士として労働生産性向上に貢献したいと考えています。

ところが、1桁の数字を全角にし、2桁以上の数字は半角にしてくださいという文化がありまして、それは非常に労働生産性の足をひっぱっていると考えています。

そこで、前回はExcel版でマクロで一気に変換してしまうものを紹介しましたが、今回はWord版を紹介します。

あちこちのブログで紹介されている

すでにあちこちのブログで紹介されていましたのでリンクをいくつか貼っておきます。

数字２桁以上と括弧を半角,数字１桁は全角にしたい。- 電脳メモ

↑電脳メモさんの記事です。これだけHTTPSでないのでリンクの貼り方が他と異なります。

Wordの場合、Excelと違って最初から正規表現が使えますので楽ですね。

いずれの記事でも正規表現を使っています。

要は、検索ボックスを開いて検索するやり方です。GUIだと一気に全部を選択できる機能も用意されているので、便利です。

VBAでやるなら

GUIの検索ボックスを使ったやり方でやるのがめんどうくさいという方向けに、一応Wordの場合のVBAを考えてみました。

コードを書くにあたって、次のページを参考にしました。

2019年に書かれた良記事です。私の記事を読むよりずっとためになります。

Private Sub findReplace( _
         ByVal targetDocument As Document, _
         ByRef stText As String, _
         ByRef wWidth As WdCharacterWidth)
  Application.ScreenUpdating = False
  targetDocument.Range(0, 0).Select '……(1)'
  With Selection.Find
    .ClearFormatting                '……(2)'
    .ClearAllFuzzyOptions
    .ClearHitHighlight
    .Replacement.ClearFormatting
'
    .Text = stText                  '……(3)'
    .Replacement.Text = "^&"        '……(4)'
    .Forward = True
    .Wrap = wdFindContinue
    .Format = False
    .Highlight = False
    .MatchCase = False
    .MatchWholeWord = False
    .MatchByte = False
    .MatchAllWordForms = False
    .MatchSoundsLike = False
    .MatchPhrase = False
    .MatchFuzzy = False
    .MatchWildcards = True          '……(5)'
  End With
  Call Selection.Find.Execute       '……(6)'
  Do While Selection.Find.Found     '……(7)'
    Selection.Range.CharacterWidth = wWidth '……(8)'
    Selection.Collapse Direction:=wdCollapseEnd '……(9)'
    Selection.Find.Execute          '……(10)'
  Loop
  Application.ScreenUpdating = True
End Sub

コードの説明

targetDocument.Range(0, 0).Select '……(1)'

ドキュメントの先頭位置にカーソルを位置づけています。

  With Selection.Find
    .ClearFormatting                '……(2)'
    .ClearAllFuzzyOptions
    .ClearHitHighlight
    .Replacement.ClearFormatting
'

↑ここではFindがもともと持っている各種オプションをきれいにクリアしています。

これをやっておかないと、ユーザが以前検索したときの条件が残ってしまった状態となってしまい、意図したとおりの動きとなりません。

    .Text = stText                  '……(3)'

↑ここでは検索文字列を引数のstTextで設定しています。stTextには正規表現を使います。

    .Replacement.Text = "^&"        '……(4)'

↑ここでは検索語の文字列を指定してます。普通、正規表現だと$1になると思うのですが、なぜかVBAだと検索してヒットした文字列を指すのは^&でした。

    .MatchWildcards = True          '……(5)'

↑ここではワイルドカードの指定をTrueにしておきます。これを忘れると正規表現が使えません。なお、MatchPhrase、MatchWildcards、MatchSoundsLike、MatchAllWordForms、MatchFuzzyパラメータは、同時にTrueに設定できないばかりではなく、それぞれTrue/Falseに設定するときに順番があるようです。

今回はMatchWildcardsをTrueにしたいので、それ以外を先にFalseにしてからMatchWildcardsをTrueに設定しました(こうしておかないと、何かの拍子にエラーが出るようです)。こちらのサイトを参考にしました。↓

https://stabucky.com/wp/archives/3458

  Selection.Find.Execute            '……(6)'

↑ここで検索を実行しています。

なお、GUIの方では一気に全部を検索することができますが、↓(検索する場所でメイン文書を選ぶ)

↑これがVBAでも出来たらよいなと思い探しましたが、VBAにこれに該当するコードは用意されていないようでした。

という訳で、仕方がないので1検索1ヒットずつ置換していきます。

  Do While Selection.Find.Found     '……(7)'

↑ここでやっていることは、Executeで検索を実行した結果、ヒットしたらFoundはTrueになります、これを利用してLoopするということです。Trueの間はずっとループします。

    Selection.Range.CharacterWidth = wWidth '……(8)'

↑ここではヒットした対象を、引数で指定した文字幅(wWidth)にしています。

    Selection.Collapse Direction:=wdCollapseEnd '……(9)'

↑ここのCollapseというのは選択を解除するメソッドです。ここで選択を解除しておかないと、次の検索を実行しても次の文字列にヒットしないのです(ずっと同じ文字ばかりヒットして永久ループに陥る)。

    Selection.Find.Execute          '……(10)'

↑ここで2回目の検索を実行しています。以降、検索結果がFalseになるまでループします。

呼び出し方法

上記のfindReplace関数を呼び出す方法を説明します。

Public Sub 数字1桁全角2桁以上半角変換()
  Dim Doc As Document
  Set Doc = ActiveDocument
  Call findReplace(Doc, "[0-9０-９,.,．]", wdWidthFullWidth)        '……(11)'
  Call findReplace(Doc, "[0-9０-９,.,．]{2,}", wdWidthHalfWidth)    '……(12)'
  Set Doc = Nothing
End Sub

(11)は全角にする文字を指定しています。1桁の数字です。

(12)は半角にする文字を指定しています。2桁以上の数字です。{2,}の2がこの条件に該当する文字が2個連続するの意味です。カンマの後は本当は文字列の最大数を指定するのですが、省略もできるので省略しています。

このような文書を用意します。

マクロを実行します。

実行結果はこうなります。

免責事項

あなたがここで紹介したコードを実行するのはかまいませんが、それにより被るいかなる被害も当方では責任を負えません。ご自身の責任の下で実行してください。このコードを実行した結果、大切なデータが損壊しても、当方は一切の責任を負いません。

なお、コードを使うのは自由ですが、私は著作権までは放棄していません。

あと、今回作ったコードではテキストボックスは検索できません。

まとめ

Wordで1桁の数字を全角、2桁以上の数字を半角にする方法を紹介しました。

Webを軽く検索しただけでもわさわさとヒットしましたので、やはりニーズは高いようですね。

このアホみたいな文化が日本に定着しないことを願います。将来、なくなりますように。

でもそれまで苦しむ人がいると気の毒なので、簡単にできる方法を考えてみました。

何かのお役に立てば幸いです。

ここまでお読みくださりありがとうございました。