算用数字を英語表記にすることはありますか？日英翻訳者であればあるかもしれません。
Wordではフィールドコードを使うと100万未満の数字を英語表記に変更できます。「\* cardtext」という書式スイッチを使います。
でも、フィールドコードをわざわざ書くのはちょっと面倒ですよね。このフィールドコードを使ってちょっと面白いマクロができたので紹介します。
いろいろと制限があるマクロですが、マクロの仕組みが面白いと思うので紹介します。
＜目次＞
このマクロでできること
選択されている範囲にある算用数字の英語表記をメッセージボックスで表示します。また、表示内容をクリップボードにコピーします。
ただし、細かくチューニングしたマクロではないので制限があります。ご注意ください。
小数点がある場合や複数の数字が含まれている場合にはおかしなことになります。算用数字をすべて結合してしまうからです。
以下の例では、100995を英語表記にしています。
また、マイナス記号は考慮できません。100万以上の数字では計算できません。
Rangeオブジェクトを一時的に利用する
今回のマクロでは、フィールドコードの処理結果を得るために専用のRangeオブジェクトを一時的に作成して使っています。
かつて紹介した記事「【コード】表内の文字数を計算するWordマクロ（その２）」では、文字数を数えるための処理用に新規ファイルを作成して処理後に保存せずに閉じる（ファイルを捨てる）という手法を紹介しました。これと同じ考え方です。
私はこの新規ファイルを一時的に作成するという手法をツール開発でよく使っています。
Excelマクロでいうと、計算用に一時的にシート追加するという感じでしょうか。
ただ、この新規ファイルを用いる方法は、ファイルを開いて閉じるためそれなりに時間がかかってしまいます。
そこで、今回紹介する方法を提案します。
後述の通りデメリットもあるので、用途に応じて使い分けてみてください。
今回の方法では、以下の手順を踏んでいます。
- 文書の末尾に処理用のRangeオブジェクトを作成
- このRangeオブジェクト内で処理を実行
- 処理が終了したら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
