【Word VBA】フィールドコードを使って数字の英語表記を取得するWordマクロ

2021年12月7日

算用数字を英語表記にすることはありますか？日英翻訳者であればあるかもしれません。

Wordではフィールドコードを使うと100万未満の数字を英語表記に変更できます。「\* cardtext」という書式スイッチを使います。

でも、フィールドコードをわざわざ書くのはちょっと面倒ですよね。このフィールドコードを使ってちょっと面白いマクロができたので紹介します。

いろいろと制限があるマクロですが、マクロの仕組みが面白いと思うので紹介します。

このマクロでできること

選択されている範囲にある算用数字の英語表記をメッセージボックスで表示します。また、表示内容をクリップボードにコピーします。

ただし、細かくチューニングしたマクロではないので制限があります。ご注意ください。

小数点がある場合や複数の数字が含まれている場合にはおかしなことになります。算用数字をすべて結合してしまうからです。

以下の例では、100995を英語表記にしています。

また、マイナス記号は考慮できません。100万以上の数字では計算できません。

Rangeオブジェクトを一時的に利用する

今回のマクロでは、フィールドコードの処理結果を得るために専用のRangeオブジェクトを一時的に作成して使っています。

かつて紹介した記事「【コード】表内の文字数を計算するWordマクロ（その２）」では、文字数を数えるための処理用に新規ファイルを作成して処理後に保存せずに閉じる（ファイルを捨てる）という手法を紹介しました。これと同じ考え方です。

私はこの新規ファイルを一時的に作成するという手法をツール開発でよく使っています。

Excelマクロでいうと、計算用に一時的にシート追加するという感じでしょうか。

ただ、この新規ファイルを用いる方法は、ファイルを開いて閉じるためそれなりに時間がかかってしまいます。

そこで、今回紹介する方法を提案します。

後述の通りデメリットもあるので、用途に応じて使い分けてみてください。

今回の方法では、以下の手順を踏んでいます。

  1. 文書の末尾に処理用のRangeオブジェクトを作成
  2. このRangeオブジェクト内で処理を実行
  3. 処理が終了したらRangeオブジェクトを削除

さらに、この一時的な処理がWordファイルの履歴に残らないように、UndoRecordオブジェクト（Word 2010以降で利用可能）を使っています。

マクロの解説

具体的に見てみます。

17行目でRangeオブジェクトを文書の末尾に作成しています。

24行目でFieldオブジェクトを設定して26行目のResultプロパティが返すRangeオブジェクトでフィールドの計算結果を取得します。

処理が終わったら28行目でRangeオブジェクトを削除します。

この一連の処理の前後の状態をUndoRecordオブジェクトで記録しています。

このようにすると、処理の前と処理の後の状態が同じということになり履歴にマクロ処理（文書の末尾にRangeオブジェクトを挿入したこと）が残りません。

でも、マクロ実行前の履歴は残っているという状態なので、UndoClearメソッドとも違います。これいいでしょ？

マクロのデメリット

今回の方法では、文書の末尾にRangeオブジェクトを挿入しています。

処理の途中でマクロが止まってしまったときに文書末尾に挿入した文字列が残ってしまいます。

これを回避するためには、文書末尾以外の箇所に仮のRangeオブジェクトを置いてもいいかもしれません。

マクロ


Sub Number2Word()
　
　If Selection.Type = wdSelectionIP Then
　　Selection.Expand wdWord
　End If
　
　'-------------------------------------------
　'UndoRecordの利用
　'-------------------------------------------
　#If VBA7 Then
　　Dim objUndo As UndoRecord
　　Set objUndo = Application.UndoRecord
　　objUndo.StartCustomRecord ("Rangeオブジェクト作成を履歴に残さない仕組み")
　#End If

　Dim myRange As Range
　Set myRange = ActiveDocument.Bookmarks("\EndOfDoc").Range
　
　Dim myNumber As Long
　myNumber = GetNumber(Selection.Text)
　
　If myNumber >= 0 And myNumber < 1000000 Then
　　Dim NumberField As Field
　　Set NumberField = myRange.Fields.Add(myRange, wdFieldEmpty, "=" & myNumber & "\*cardtext")
　　Dim myText As String
　　myText = NumberField.Result.Text
　　NumberField.Result.Copy
　　myRange.Delete
　Else
　　myText = "0～999,999の数字のみ変換できます"
　End If
　
　'-------------------------------------------
　'UndoRecordの利用
　'-------------------------------------------
　#If VBA7 Then
　　objUndo.EndCustomRecord
　　Set objUndo = Nothing
　　Application.ScreenRefresh
　#End If
　
　MsgBox myText
　
End Sub

Function GetNumber(myText As String) As Long
　
　'半角文字に変換
　myText = StrConv(myText, vbNarrow)
　
　'半角数字のみ抽出
　Dim RE As Object
　Set RE = CreateObject("VBScript.RegExp")
　
　With RE
　　.Pattern = "[^0-9]{1,}"
　　.Global = True
　　Dim Result As String
　　Result = .Replace(myText, "")
　End With
　
　Set RE = Nothing
　
　If Result = "" Then
　　GetNumber = "-1"
　Else
　　GetNumber = CLng(Result)
　End If

End Function

関連記事

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

-コード