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

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

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

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

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

このマクロでできること

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

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

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

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

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

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

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

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

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

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マクロ(その2)

トップへ戻る