洋々亭　文書処理・お仕事Tips

お仕事Tipsトップ >> Word：算用数字⇒漢数字変換マクロ

■Word：算用数字⇒漢数字変換マクロ

　漢数字⇒算用数字変換マクロがあれば、その逆もありますので、作っただけです。

　Microsoft Wordで、算用数字（アラビア数字）を一括して漢数字に変換します。

　でも、用途として考えられるのは、多分、縦書き例規の自治体が、他の横書き自治体の条例・規則をパクるとき(^ ^;)くらいですかね。

　New! 算用数字⇒漢数字変換マクロがVer0.3にバージョンアップ（2010/9/20)

　　・小数点以下や「問題十五」など接頭単位にも対応して、変換精度もアップ。

■ マクロコードの登録について

下記のマクロコードをコピーします。
（コードの下の [ コードを全選択 ] をクリックすると選択状態になるので、コードを右クリックして、ポップアップメニューの[コピー]を選びます。）
Wordで新規文書を起動し、ショートカットキー　 Alt ＋　F11 　でマクロ編集画面（VBA ：右図）を開きます。
VBAの左側のペインで、Normalの標準モジュールの中のModule1を選択します。
　※　もし、Normalの中に標準モジュールがない場合は、Normalを右クリックし表示されるメニューから[挿入]⇒[標準モジュール]をクリックして追加します。
コード欄にコピーしたコードを貼り付けます。
　　（詳細：Wordマクロコードの登録方法）
そのマクロに不安があったら：
ネットからコピーしたコードには、ウイルスが潜んでいる可能性があります。不安があったら、空白文書にいったん保存し、そのファイルを「Wordで開く前に」ワクチンソフトでチェックしてから利用しましょう。（個別文書に登録し、ウイルスと作動チェックを行う方法）

Option Explicit

Sub 算用to漢数字変換()
'------------------------------------------------------------------------
'テキストの英数字を漢数字に変換（半角0-9、全角０-９いずれも可）
'作成者　洋々亭 2006-2010
' 2006/8/27  Ver0.1
' 2010/10/4  ver0.4 ロジック整理
'○呼び出すサブルーチン：
'  ①conv2kan(skan, setketa)
'     ※setketa:1(KETAMOJI)で桁文字（十百千）使用、0(NOKETA)で桁文字不使用
'------------------------------------------------------------------------
'
  Const KETAMOJI = 0  ' 七千三十五
  Const NOKETA = 1    ' 七○三五
  Dim flgketa As Long
   ' flgketa設定：(漢数くん使用時は引数使用)
   ' 0(KETAMOJI)…千百十使う。／0(NOKETA)…千百十使わない
  Dim str As String
  Dim piriunit As String
  Dim strbuf As String, pstr As String
  Dim RE As Object, RE2 As Object, Matches As Object, Match As Object
  Dim myRange As Range
  Dim para As Paragraph
  Dim buf As String
  Set RE = CreateObject("VBScript.RegExp")
  Set RE2 = CreateObject("VBScript.RegExp")
  RE.Global = False   'True:全ての検索結果を処理、False:初出の結果のみ処理
  RE2.Global = False
   
    ' ピリオド単位
  piriunit = "(．|\.)"
  
    ' 変換範囲（段落：paragraph単位で変換）
  If Selection.Start = Selection.End Then
    Set myRange = ActiveDocument.Range   '範囲選択しなければ文書全体
  Else
    Set myRange = Selection.Range    '選択された範囲内の段落のみ
  End If
  
  For Each para In myRange.Paragraphs
      ' 途中でパラグラフを移動させないため、文字列bufにコピーして作業
    buf = para.Range.Text
    
    ' 先に小数点[．|.]以下を変換（「三○五四」のようにベタ変換）
    RE.Pattern = piriunit & "([0-9]+|[０１２３４５６７８９]+)"
    Do
      Set Matches = RE.Execute(buf)
      If Matches.Count > 0 Then
        str = conv2kan(Matches(0).SubMatches(1), NOKETA)
        str = "・" & str
        RE2.Pattern = Matches(0).Value
        buf = RE2.Replace(buf, str)
      End If
    Loop Until Matches.Count = 0
   
    '「NN,NNN,NNN,NNN ／　N,NNN億、N,NNN万」変換
    RE.Pattern = "([0-9,]+|[０１２３４５６７８９，]+)"
    Do
      Set Matches = RE.Execute(buf)
      If Matches.Count > 0 Then
        strbuf = Replace(Matches(0).SubMatches(0), ",", "") 'カンマ削除
        str = ""
        If Len(strbuf) > 16 Then
          pstr = Left(strbuf, Len(strbuf) - 16)
          str = conv2kan(pstr, flgketa) & "京"
          strbuf = Right(strbuf, 16)
        End If
        If Len(strbuf) > 12 Then
          pstr = Left(strbuf, Len(strbuf) - 12)
          str = conv2kan(pstr, flgketa) & "兆"
          strbuf = Right(strbuf, 12)
        End If
        If Len(strbuf) > 8 Then
          pstr = Left(strbuf, Len(strbuf) - 8)
          str = str & conv2kan(pstr, flgketa) & "億"
          strbuf = Right(strbuf, 8)
        End If
        If Len(strbuf) > 4 Then
          pstr = Left(strbuf, Len(strbuf) - 4)
          str = str & conv2kan(pstr, flgketa) & "万"
          strbuf = Right(strbuf, 4)
        End If
        If Len(strbuf) > 0 Then
          pstr = strbuf
          str = str & conv2kan(pstr, flgketa)
        End If
        RE2.Pattern = Matches(0).Value
        buf = RE2.Replace(buf, str)
      End If
    Loop Until Matches.Count = 0
      ' 作業bufが変更されていたら、paragraph置き換え
    If buf <> para.Range.Text Then
      para.Range.Text = buf
    End If
  Next
  Set RE = Nothing
  Set Matches = Nothing
  Set Match = Nothing
  Set myRange = Nothing
End Sub

Function conv2kan(ssan As String, Optional setketa As Long) As String
'
'---------------------------------------------------------------------
' conv2kan関数 ：英数字の文字列を漢数字の文字列に変換する。
' 作成者　洋々亭 2006-2010
' ○引数
'     ssan  ：処理する英数字（「0-9」,「０-９」どちらも可）
'     setketa：1(KETAMOJI)で桁文字（十百千）使用、0(NOKETA)で桁文字不使用
' ○戻り値
'     変換結果の文字列
'---------------------------------------------------------------------
'
    Const KETAMOJI = 0
    Const NOKETA = 1
    Const ALwpNUM = "０１２３４５６７８９，．"
    Const ALpNUM = "0123456789,."
    Const KANKETA2 = "一十百千"     '桁漢字（一～千)
    Const KANNUM = "一二三四五六七八九"  '桁漢字あり用
    Const KANopNUM = "〇一二三四五六七八九、・"  '桁漢字無(ピリオド付き）
    Dim sbuf As String, swork As String
    Dim ileng As Long
    Dim iketa As Long, pos As Long, i As Long, cnt As Long
    
    ileng = Len(ssan)
    pos = ileng      'pos:漢字文字列中の処理中文字ポインタ
    iketa = 1       '現在処理中の英数字の桁数
    '全部半角に変換
    swork = ""
    pos = 0
    For i = 1 To ileng
      pos = InStr(ALwpNUM, Mid(ssan, i, 1))
      If pos > 0 Then
        swork = swork & Mid(ALpNUM, pos, 1)
      Else
        swork = swork & Mid(ssan, i, 1)
      End If
    Next
    sbuf = ""
    If setketa = NOKETA Then
      '桁漢字を使わない表記の場合（例：一七〇五）
      For i = 1 To ileng
        cnt = InStr(ALpNUM, Mid(swork, i, 1))
        sbuf = sbuf & Mid(KANopNUM, cnt, 1)
      Next
      conv2kan = sbuf
      Exit Function
    Else
      '桁漢字を使った表記の場合 （例：千七百五）
      swork = Replace(swork, ",", "") 'カンマ削除
      iketa = 1           '現在処理中の英数字の桁数
      ileng = Len(swork)      '文字列長再取得
      For i = ileng To 1 Step -1
        cnt = Val(Mid(swork, i, 1))
        If cnt = 1 Then
          sbuf = Mid(KANKETA2, iketa, 1) & sbuf
        ElseIf cnt >= 2 And cnt <= 9 Then
          If iketa = 1 Then
            sbuf = Mid(KANNUM, cnt, 1) & sbuf
          Else
            sbuf = Mid(KANKETA2, iketa, 1) & sbuf
            sbuf = Mid(KANNUM, cnt, 1) & sbuf
          End If
        End If
        iketa = iketa + 1
      Next
    End If
    conv2kan = sbuf
    Exit Function
End Function

' ===================== End Of Code =======================

↑

■本マクロの使い方

変換したい文書を、Wordに貼り付ける。
処理範囲を指定できます。一部のみ変換したいときは、マウスで範囲を指定してから、以下に進んでください。範囲指定しない場合は文書全体が処理範囲となります。
マクロ実行ダイアログから実行：
Wordを起動し、ショートカットキー　 Alt ＋　F８　でマクロ実行ダイアログを開きます。
マクロダイアログで「算用to漢数字変換」を選択し、[実行]を押す。

※　参照：マクロの使い方と登録方法

このマクロはフリーソフトとし、取扱いはGPLに準拠します。
ただし、他のマクロに組み込んだり、その他の方法で、他に配布する場合は原作著作表示を残していただけるとうれしいです。
作者はこのマクロ及び本ドキュメントを使用した結果について何ら責任を負いません。

↑