TOP > blog > 20.インデザインスクリプト 初級講座 はがきの宛名をレイアウト(1)
インデザインスクリプト
2016/03/01

20.インデザインスクリプト 初級講座 はがきの宛名をレイアウト(1)

管理者用
blog

はがきの宛名をレイアウト 準備 編で、エクセルの宛名リストを準備しました
また、実際に宛名レイアウトした状態でテキストフレームの座標値を書きとめていただきました。
ページを追加しながらのスクリプトに、実際の組版のスクリプトを追加して行きます。

 

宛名レイアウト完成イメージから座標取得

宛名組版座標

組版仕様

テキストフレームの座標値は、書き止めていますが、まだまだ、決めておかなければならないレイアウト仕様が有ります。

郵便番号の配置については、7ケタを34ケタに分けてそれぞれを配置することとしました。
しかし、日本郵便のホームページには、配置に関する仕様が記載されてます。
この仕様に沿って配置位置を決めて行くやり方もあります。

住所については、ビル・マンション名等の配置をどうするか決めておく必要があります。
住所1と住所2を合わせても1行に収まる場合は、1行にする/しない。
住所1の文字数が多くて1行に収まらない場合、文字サイズを小さくするのか、その場合の住所2のフォントサイズはどうするのか?
住所情報は、テキストフレームを2フレームでレイアウトしようとしてますが、1フレームの2行で行う方法もあります。

名前の配置では、配置のバランスをどうするのか、文字間の間にスペースを入れて対応する場合が多いのですが、姓名の文字数によりどのように配置するか決めておく必要があります。

最初に考えていても想定外の事が出てくると思います。慣れないうちは、実際に配置しながら、仕様を固めて行くのが現実的かもしれません。
組版仕様や、スクリプトのプログラミングは、
人それぞれです。ここに取り上げた方法もその中の一つの例として参考にしてください。

宛名レイアウト実行結果1

 

宛名レイアウト実行結果2

メイン処理スクリプト

準備編に、各情報を組版していくスクリプトを追加記述してます。
作成した関数は、後の項で紹介していますので、参照してください。



Private Sub CommandButton1_Click()

    cuntC = 2
    cuntA = Sheet1.Cells(cuntC, 1)
    
    If Not cuntA = "" Then

        Set myInDesign = CreateObject("InDesign.Application.CC_J") 'インデザインを起動する
            MsgBox "ドキュメントを開きます!"
            'dir_mei = "T:\NAVI_VBA\VBA_101\"
            dir_mei = "G:\NAVI_VBA\VBA_101\"
            
            INDD_name = dir_mei & "hagaki_NSK.indd"
            Set myDocument = myInDesign.Open(INDD_name)

        Do While cuntA <> ""
        
            If cuntC >= 3 Then
                myDocument.Pages.Add   '2行目以降のデータの時、ページを追加
            End If

            '郵便番号データの正規化
            yubin = Sheet1.Cells(cuntC, 2) '郵便番号データを取り込む
            yubin_pr = yubin_del(yubin) '郵便番号の正規化(〒、- 等の削除 関数)
            yubin_1 = Mid(yubin_pr, 1, 3) '7桁の郵便番号から先頭の3文字を抜き取る
            yubin_2 = Mid(yubin_pr, 4, 4) '7桁の郵便番号から後の4文字を抜き取る
            
             '住所データの正規化
            jyusyo1 = Sheet1.Cells(cuntC, 3) '住所データの取り込み
            jyusyo1 = sp1_1(jyusyo1) '連続スペースを1つのスペースにまとめる
            jyusyo1 = sp_cut(jyusyo1) '両端についている余計なスペースをカットする。CR98,LF,タブもスペースに
            jyusyo1 = katakana(jyusyo1) '半角カタカナを全角カタカナに変換
            jyusyo1 = sujikana(jyusyo1) '数字を漢数字に変換
            jyusyo1 = kai(jyusyo1) '最後のFを階に変換する

            '住所2のデータの正規化
            jyusyo2 = Sheet1.Cells(cuntC, 4) '住所データ(ビル・マンション等)の取り込み
            jyusyo2 = sp1_1(jyusyo2) '連続スペースを1つのスペースにまとめる
            jyusyo2 = sp_cut(jyusyo2) '両端についている余計なスペースをカットする。CR98,LF,タブもスペースに
            jyusyo2 = katakana(jyusyo2) '半角カタカナを全角カタカナに変換
            jyusyo2 = sujikana(jyusyo2) '数字を漢数字に変換
            'jyusyo2= kai(jyusyo1) '最後のFを階に変換する
            
            '名前データの正規化
            namae = Sheet1.Cells(cuntC, 5) + Sheet1.Cells(cuntC, 6) + "様"
  
            'テキストフレームに書き出し
            Set myTextFrameA = myDocument.Pages.Item(cuntC - 1).TextFrames.Add
            
            haichi_1_XS = 45.75
            haichi_1_YS = 14.6
            haichi_1_W = 16.5
            haichi_1_H = 4.3
            FontSize = 12
            kumihan_T_Y = "Y"
            Dnraku = "R"
            If TextFrameAdd(myTextFrameA, haichi_1_YS, haichi_1_XS, haichi_1_W, haichi_1_H, FontSize, kumihan_T_Y, Dnraku, yubin_1) Then
                 FontSize = OverflowsFont(myTextFrameE)
            End If
            
            Set myTextFrameB = myDocument.Pages.Item(cuntC - 1).TextFrames.Add
            haichi_1_XS = 67.1
            haichi_1_YS = 14.6
            haichi_1_W = 22.9
            haichi_1_H = 4.3
            FontSize = 12
            kumihan_T_Y = "Y"
            Dnraku = "R"
            If TextFrameAdd(myTextFrameB, haichi_1_YS, haichi_1_XS, haichi_1_W, haichi_1_H, FontSize, kumihan_T_Y, Dnraku, yubin_2) Then
                 FontSize = OverflowsFont(myTextFrameE)
            End If
            
            Set myTextFrameC = myDocument.Pages.Item(cuntC - 1).TextFrames.Add
            haichi_1_XS = 78.5
            haichi_1_YS = 27
            haichi_1_W = 6.5
            haichi_1_H = 99
            FontSize = 18
            kumihan_T_Y = "T"
            Dnraku = "T"
            If TextFrameAdd(myTextFrameC, haichi_1_YS, haichi_1_XS, haichi_1_W, haichi_1_H, FontSize, kumihan_T_Y, Dnraku, jyusyo1) Then
                 FontSize = OverflowsFont(myTextFrameE)
            End If
            
            Set myTextFrameD = myDocument.Pages.Item(cuntC - 1).TextFrames.Add
            haichi_1_XS = 72
            haichi_1_YS = 35
            haichi_1_W = 6.5
            haichi_1_H = 91
            FontSize = 18
            kumihan_T_Y = "T"
            Dnraku = "E"
            If TextFrameAdd(myTextFrameD, haichi_1_YS, haichi_1_XS, haichi_1_W, haichi_1_H, FontSize, kumihan_T_Y, Dnraku, jyusyo2) Then
                 FontSize = OverflowsFont(myTextFrameE)
            End If

            Set myTextFrameE = myDocument.Pages.Item(cuntC - 1).TextFrames.Add
            haichi_1_XS = 43.3
            haichi_1_YS = 41.5
            haichi_1_W = 13.5
            haichi_1_H = 84.5
            FontSize = 38
            kumihan_T_Y = "T"
            Dnraku = "R"
            namaeovf = TextFrameAdd(myTextFrameE, haichi_1_YS, haichi_1_XS, haichi_1_W, haichi_1_H, FontSize, kumihan_T_Y, Dnraku, namae)
            namae1 = Sheet1.Cells(cuntC, 5)
            namae2 = Sheet1.Cells(cuntC, 6)
            
            aa = namae_seikika(myTextFrameE, namae1, namae2)
            FontSize = OverflowsFont(myTextFrameE)
            
            MsgBox namae
            
            cuntC = cuntC + 1
            cuntA = Sheet1.Cells(cuntC, 1)
        Loop
    
    End If
    
    MsgBox "END"
    
End Sub
'********************************************************************************************

データの正規化

自動化においては、準備したデータの正規化は必須です。
何もしないで、データを準備出来るケースは少ないでしょう。

例えば、住所データを見た場合、縦書きに組版するのですが、数字は、漢数字に変換する必要があります。
郵便番号の場合を見るとハイホンが入っていますが、取り除く必要があります。
名前は姓名でセルを分けてデータを用意してますが、一つのデータにする必要があります。
正規化による、
データ変換は、組版仕様とも関連してきますが、重要な処理です。

'住所データの正規化
jyusyo1 = Sheet1.Cells(cuntC, 3) '住所データの取り込み
jyusyo1 = sp1_1(jyusyo1) '連続スペースを1つのスペースにまとめる
jyusyo1 = sp_cut(jyusyo1) '両端についている余計なスペースをカットする。CR98,LF,タブもスペースに
jyusyo1 = katakana(jyusyo1) '半角カタカナを全角カタカナに変換
jyusyo1 = sujikana(jyusyo1) '数字を漢数字に変換
jyusyo1 = kai(jyusyo1) '最後のFを階に変換する

 

関数

データの正規化や良く使う処理、繰り返し使う処理、他のスクリプトでも使う事が有りそうな処理などの記述は、サブルーチンや、関数(ファンクションプロシージャ)を使って行きたいと思います。

TextFrameAdd キストフレームを作る関数

テキストフレームのオブジェクト変数(参照型変数)と配置したいテキストフレーム座標、段落揃え、フォントサイズ、流し込むデータを関数に渡します。


      Set myTextFrameA = myDocument.Pages.Item(cuntC - 1).TextFrames.Add
            haichi_1_XS = 45.75
            haichi_1_YS = 14.6
            haichi_1_W = 16.5
            haichi_1_H = 4.3
            FontSize = 12
            kumihan_T_Y = "Y"
            Dnraku = "R"
            If TextFrameAdd(myTextFrameA, haichi_1_YS, haichi_1_XS, haichi_1_W, haichi_1_H, FontSize, kumihan_T_Y, Dnraku, yubin_1) Then
                 FontSize = OverflowsFont(myTextFrameE)
            End If

関数の因数で渡されたデータを基にテキストフレームを設定します。
また、オーバーフロー(溢れ)のステータスを返します。


'********************************************************************************************
Function TextFrameAdd(myTextFrame, YS, XS, W, H, FontSize, kumihan_T_Y, Dnraku, dataIn)

    YE = YS + H
    XE = XS + W
    myTextFrame.GeometricBounds = Array(CStr(YS) + "mm", CStr(XS) + "mm", CStr(YE) + "mm", CStr(XE) + "mm")
    myTextFrame.ParentStory.PointSize = CStr(FontSize)
    If kumihan_T_Y = "T" Then
        myTextFrame.ParentStory.StoryPreferences.StoryOrientation = idHorizontalOrVertical.idVertical '1986359924 ''縦書き
    End If
    
    Select Case Dnraku
       Case "T"
            myTextFrame.ParentStory.Justification = idJustification.idLeftAlign ' 1818584692 (&H6C656674)
       Case "E"
            myTextFrame.ParentStory.Justification = idJustification.idRightAlign ' 1919379572 (&H72676874)'末
       Case "C"
            myTextFrame.ParentStory.Justification = idJustification.idCenterJustified ' 1667920756 (&H636A7374)'中央
       Case "R"
            myTextFrame.ParentStory.Justification = idJustification.idFullyJustified ' 1718971500 (&H66756C6C)'両端
       Case Else
            myTextFrame.ParentStory.Justification = idJustification.idRightAlign
    End Select
    myTextFrame.Contents = dataIn
    
    TextFrameAdd = myTextFrame.Overflows 'False/True 溢れているか

End Function
'********************************************************************************************

オーバフロー処理 関数

テキストフレームのオーバフローが発生していた場合、フォントサイズを小さくして対応する関数です。
インデザインには、結合機能がありますが、オーバーフローしていても、対応できません。
スクリプトでは、状態確認から、対応する事ができます。スクリプトの良いところでしょう。
オーバーフローの対応として、長体、平体、文字間、フレーム拡張・・・・等を使ってスクリプトを考えてみると良いと思います。
ぜひチャレンジしてみてください。


'********************************************************************************************
Function OverflowsFont(myTextFrame)
    Font_OVF = 0
    FontSize = CInt(myTextFrame.ParentStory.PointSize)
    Do While Font_OVF = 0
        If myTextFrame.Overflows Then
            FontSize = FontSize - 0.5
            myTextFrame.ParentStory.PointSize = CStr(FontSize)
        Else
            Font_OVF = 1
        End If
    Loop
    OverflowsFont = CInt(myTextFrame.ParentStory.PointSize)
End Function
'********************************************************************************************

郵便番号正規化 関数

郵便番号の正規化の関数です。
一般的には、決まった形式で記入されていれば必要の無いスクリプトです。
宛名印刷の入稿データを扱っていると様々な形式で記入されています。
実際に使用している関数とほとんど同じものです。参照してください。

'********************************************************************************************
Function yubin_del(yubin_Bango)
'〒 コードチェック&削除
    yubin_Bango = LTrim(yubin_Bango)   '両端スペース削除
    yubin_Bango = RTrim(yubin_Bango)
    yubin_Bango = sp1_1(yubin_Bango)
    yubin_Bango = sp_cut(yubin_Bango)

    yua = Left(yubin_Bango, 1)
    
    If yua = "〒" Then
        yubin_Bango = Mid(yubin_Bango, 2, 10)
    End If

    '郵便番号123-4567→1234567
    yubin_Bango = mainasu(yubin_Bango)
    yubin_Bango = zen_hankaku(yubin_Bango)
    'yubin_Bango = StrConv(yubin_Bango, 8)  '半角へ変換
    
    jj = Mid(yubin_Bango, 4, 1)
    If jj = "-" Then
        az = Mid(yubin_Bango, 1, 3)
        ay = Mid(yubin_Bango, 5, 9)
        az = az + ay
    Else
    az = yubin_Bango
    End If
    '郵便番号レングス調査  3桁の場合
    If Not Len(az) <= 7 Then
        az = Left(az, 3)
    yubin_del = az + "    "
     Else
        yubin_del = az
    End If
     
End Function
'********************************************************************************************

名前のレイアウト調整 関数

名前のレイアウト体裁を文字間で調整します。
姓名の文字数に合わせて、文字間を調整してますが、全ての組み合わせで試みてませんので、2文字3文字など設定していてください。
また、文字間にスペースを入れて体裁を整える方法もあります。色々研究して見ると面白いと思います。
敬称の様も同じフレームにいれてレイアウトしてます。名前と様の文字間にも注意してください。

'********************************************************************************************
Function namae_seikika(myTextFrame, namaesei, namaemei)
    na_len1 = Len(namaesei)
    na_len2 = Len(namaemei)

    Select Case na_len1

        Case 1
            Select Case na_len2
                Case 0
                Case 1
                            myTextFrame.ParentStory.Tracking = 0
                            myTextFrame.ParentStory.Characters.Item(1).Tracking = 1000
                Case 2
                            'myTextFrame1.ParentStory.Tracking = 800
                            myTextFrame.ParentStory.Characters.Item(1).Tracking = 800
                            myTextFrame.ParentStory.Characters.Item(3).Tracking = 0
                Case 3
                            myTextFrame.ParentStory.Tracking = 100
                            myTextFrame.ParentStory.Characters.Item(1).Tracking = 800
                            myTextFrame.ParentStory.Characters.Item(4).Tracking = 200
                Case Else

            End Select

        Case 2
            Select Case na_len2
                Case 0
                            myTextFrame.ParentStory.Tracking = 0
                            myTextFrame.ParentStory.Characters.Item(na_len1).Tracking = 0
                Case 1
                            'myTextFrame1.ParentStory.Tracking =800
                            myTextFrame.ParentStory.Characters.Item(2).Tracking = 800
                            myTextFrame.ParentStory.Characters.Item(3).Tracking = 0
                Case 2
                            'myTextFrame1.ParentStory.Tracking = 350
                            myTextFrame.ParentStory.Characters.Item(2).Tracking = 200
                            myTextFrame.ParentStory.Characters.Item(4).Tracking = 200
                Case 3
                            myTextFrame.ParentStory.Tracking = 0
                            myTextFrame.ParentStory.Characters.Item(1).Tracking = 300
                            myTextFrame.ParentStory.Characters.Item(2).Tracking = 300
                Case Else

            End Select
            
        Case 3
            Select Case na_len2
                Case 0
                            myTextFrame.ParentStory.Tracking = 0
                            myTextFrame.ParentStory.Characters.Item(na_len1).Tracking = 0
                Case 1
                            'myTextFrame1.ParentStory.Tracking = 100
                            myTextFrame.ParentStory.Characters.Item(3).Tracking = 600
                            myTextFrame.ParentStory.Characters.Item(4).Tracking = 200
                Case 2
                            myTextFrame.ParentStory.Tracking = 0
                            myTextFrame.ParentStory.Characters.Item(3).Tracking = 300
                            myTextFrame.ParentStory.Characters.Item(4).Tracking = 300
                            myTextFrame.ParentStory.Characters.Item(5).Tracking = 300
                            
                Case 3
                            myTextFrame.ParentStory.Tracking = 0
                            myTextFrame.ParentStory.Characters.Item(3).Tracking = 200
                            myTextFrame.ParentStory.Characters.Item(6).Tracking = 200
                            
                Case Else

            End Select

        Case 4
             Select Case na_len2

                Case 0
                            'myTextFrame1.ParentStory.Tracking = 300
                            myTextFrame.ParentStory.Characters.Item(na_len1).Tracking = 0
                Case 1

                Case 2

                Case 3

                Case Else

            End Select

        Case Else
            Select Case na_len2
                Case 0
                Case Else
            End Select
        End Select

	namae_seikika = True

End Function
'********************************************************************************************

データ正規化 関数

簡単な関数ですが、書くとなると面倒です。
今回使用した関数は、実際に使用しているものです。
結構、便利に使用してます。

 

全角英数字を半角英数字に変換

'********************************************************************************************
Function zen_hankaku(moji)

    moji = Replace(moji, "1", "1")
    moji = Replace(moji, "2", "2")
    moji = Replace(moji, "3", "3")
    moji = Replace(moji, "4", "4")
    moji = Replace(moji, "5", "5")
    moji = Replace(moji, "6", "6")
    moji = Replace(moji, "7", "7")
    moji = Replace(moji, "8", "8")
    moji = Replace(moji, "9", "9")
    moji = Replace(moji, "0", "0")
    moji = Replace(moji, "A", "A")
    moji = Replace(moji, "B", "B")
    moji = Replace(moji, "C", "C")
    moji = Replace(moji, "D", "D")
    moji = Replace(moji, "E", "E")
    moji = Replace(moji, "F", "F")
    moji = Replace(moji, "G", "G")
    moji = Replace(moji, "H", "H")
    moji = Replace(moji, "I", "I")
    moji = Replace(moji, "J", "J")
    moji = Replace(moji, "K", "K")
    moji = Replace(moji, "L", "L")
    moji = Replace(moji, "M", "M")
    moji = Replace(moji, "N", "N")
    moji = Replace(moji, "O", "O")
    moji = Replace(moji, "P", "P")
    moji = Replace(moji, "Q", "Q")
    moji = Replace(moji, "R", "R")
    moji = Replace(moji, "S", "S")
    moji = Replace(moji, "T", "T")
    moji = Replace(moji, "U", "U")
    moji = Replace(moji, "V", "V")
    moji = Replace(moji, "W", "W")
    moji = Replace(moji, "X", "X")
    moji = Replace(moji, "Y", "Y")
    moji = Replace(moji, "Z", "Z")
    moji = Replace(moji, "a", "a")
    moji = Replace(moji, "b", "b")
    moji = Replace(moji, "c", "c")
    moji = Replace(moji, "d", "d")
    moji = Replace(moji, "e", "e")
    moji = Replace(moji, "f", "f")
    moji = Replace(moji, "g", "g")
    moji = Replace(moji, "h", "h")
    moji = Replace(moji, "i", "i")
    moji = Replace(moji, "j", "j")
    moji = Replace(moji, "k", "k")
    moji = Replace(moji, "l", "l")
    moji = Replace(moji, "m", "m")
    moji = Replace(moji, "n", "n")
    moji = Replace(moji, "o", "o")
    moji = Replace(moji, "p", "p")
    moji = Replace(moji, "q", "q")
    moji = Replace(moji, "r", "r")
    moji = Replace(moji, "s", "s")
    moji = Replace(moji, "t", "t")
    moji = Replace(moji, "u", "u")
    moji = Replace(moji, "v", "v")
    moji = Replace(moji, "w", "w")
    moji = Replace(moji, "x", "x")
    moji = Replace(moji, "y", "y")
    moji = Replace(moji, "z", "z")
    moji = Replace(moji, "ー", "-")
    moji = Replace(moji, " ", " ")

    zen_hankaku = moji

End Function
'********************************************************************************************

ハイフォンの変換

見た目はマイナスを集めて、同じコードに変換するもにおです。

'********************************************************************************************
Function mainasu(moji)

    moji = Replace(moji, "ー", "ー")
    moji = Replace(moji, "‐", "ー")
    moji = Replace(moji, "-", "ー")
    moji = Replace(moji, "―", "ー")
    moji = Replace(moji, "-", "ー")
    moji = Replace(moji, "-", "ー")
    moji = Replace(moji, "‐", "ー")

    mainasu = moji

End Function
'********************************************************************************************

連続スペースを一つにまとめる関数

'********************************************************************************************
Function sp1_1(moji)

'連続スペースを1つのスペースにまとめる

    If Not IsNull(moji) Or Not moji = "" Then

        moji = LTrim(moji)   '両端スペース削除
        moji = RTrim(moji)
        moji = Replace(moji, "   ", " ")
        moji = Replace(moji, "   ", " ")
        moji = Replace(moji, "  ", " ")
        moji = Replace(moji, "  ", " ")
        moji = Replace(moji, " ", " ")

        cvat_A = moji
    Else
    cvat_A = ""
    End If
    sp1_1 = cvat_A

End Function
'********************************************************************************************

両端スペースをカットする関数
CR、LF、TABコードはスペースに変換します。

'********************************************************************************************
Function sp_cut(moji)

'両端についている余計なスペースをカットする。CR98,LF,タブもスペースに
    CR_cod = Chr(13)
    LF_cod = Chr(10)
    TB_cod = Chr(9)
    moji = Replace(moji, CR_cod, " ")
    moji = Replace(moji, LF_cod, " ")
    moji = Replace(moji, TB_cod, " ")

    moji = LTrim(moji)   '両端スペース削除
    moji = RTrim(moji)
    sp_cut = moji
    AB = 0
    If Not moji = "" Then
        AB = Len(moji)
        If AB = 1 Then
                mojiA = Replace(moji, " ", " ")
            If mojiA = " " Then
                sp_cut = ""
            End If
        End If
    End If

End Function
'********************************************************************************************

半角カタカナを全角に変換

'********************************************************************************************
Function katakana(moji)
'半角カタカナを全角カタカナに変換

    moji = LTrim(moji)   '両端スペース削除
    moji = RTrim(moji)

    moji = mainasu(moji)

    moji = Replace(moji, "ガ", "ガ")
    moji = Replace(moji, "ギ", "ギ")
    moji = Replace(moji, "グ", "グ")
    moji = Replace(moji, "ゲ", "ゲ")
    moji = Replace(moji, "ゴ", "ゴ")
    moji = Replace(moji, "ザ", "ザ")
    moji = Replace(moji, "ジ", "ジ")
    moji = Replace(moji, "ズ", "ズ")
    moji = Replace(moji, "ゼ", "ゼ")
    moji = Replace(moji, "ゾ", "ゾ")
    moji = Replace(moji, "ダ", "ダ")
    moji = Replace(moji, "ヂ", "ヂ")
    moji = Replace(moji, "ヅ", "ヅ")
    moji = Replace(moji, "デ", "デ")
    moji = Replace(moji, "ド", "ド")
    moji = Replace(moji, "バ", "バ")
    moji = Replace(moji, "ビ", "ビ")
    moji = Replace(moji, "ブ", "ブ")
    moji = Replace(moji, "ベ", "ベ")
    moji = Replace(moji, "ボ", "ボ")
    moji = Replace(moji, "パ", "パ")
    moji = Replace(moji, "ピ", "ピ")
    moji = Replace(moji, "プ", "プ")
    moji = Replace(moji, "ペ", "ペ")
    moji = Replace(moji, "ポ", "ポ")

    moji = Replace(moji, "ア", "ア")
    moji = Replace(moji, "イ", "イ")
    moji = Replace(moji, "ウ", "ウ")
    moji = Replace(moji, "エ", "エ")
    moji = Replace(moji, "オ", "オ")
    moji = Replace(moji, "カ", "カ")
    moji = Replace(moji, "キ", "キ")
    moji = Replace(moji, "ク", "ク")
    moji = Replace(moji, "ケ", "ケ")
    moji = Replace(moji, "コ", "コ")
    moji = Replace(moji, "サ", "サ")
    moji = Replace(moji, "シ", "シ")
    moji = Replace(moji, "ス", "ス")
    moji = Replace(moji, "セ", "セ")
    moji = Replace(moji, "ソ", "ソ")
    moji = Replace(moji, "タ", "タ")
    moji = Replace(moji, "チ", "チ")
    moji = Replace(moji, "ツ", "ツ")
    moji = Replace(moji, "テ", "テ")
    moji = Replace(moji, "ト", "ト")
    moji = Replace(moji, "ナ", "ナ")
    moji = Replace(moji, "ニ", "ニ")
    moji = Replace(moji, "ヌ", "ヌ")
    moji = Replace(moji, "ネ", "ネ")
    moji = Replace(moji, "ノ", "ノ")
    moji = Replace(moji, "ハ", "ハ")
    moji = Replace(moji, "ヒ", "ヒ")
    moji = Replace(moji, "フ", "フ")
    moji = Replace(moji, "ヘ", "ヘ")
    moji = Replace(moji, "ホ", "ホ")
    moji = Replace(moji, "マ", "マ")
    moji = Replace(moji, "ミ", "ミ")
    moji = Replace(moji, "ム", "ム")
    moji = Replace(moji, "メ", "メ")
    moji = Replace(moji, "モ", "モ")
    moji = Replace(moji, "ヤ", "ヤ")
    moji = Replace(moji, "ユ", "ユ")
    moji = Replace(moji, "ヨ", "ヨ")
    moji = Replace(moji, "ラ", "ラ")
    moji = Replace(moji, "リ", "リ")
    moji = Replace(moji, "ル", "ル")
    moji = Replace(moji, "レ", "レ")
    moji = Replace(moji, "ロ", "ロ")
    moji = Replace(moji, "ワ", "ワ")
    moji = Replace(moji, "ヲ", "ヲ")
    moji = Replace(moji, "ン", "ン")

    moji = Replace(moji, "ァ", "ァ")
    moji = Replace(moji, "ィ", "ィ")
    moji = Replace(moji, "ゥ", "ゥ")
    moji = Replace(moji, "ェ", "ェ")
    moji = Replace(moji, "ォ", "ォ")
    moji = Replace(moji, "ヵ", "ヵ")
    moji = Replace(moji, "ヶ", "ヶ")
    moji = Replace(moji, "ッ", "ッ")
    moji = Replace(moji, "ャ", "ャ")
    moji = Replace(moji, "ュ", "ュ")
    moji = Replace(moji, "ョ", "ョ")
    'moji = Replace(moji, "ヮ", "ヮ")
    moji = Replace(moji, "ー", "ー")

    katakana = moji

End Function

'********************************************************************************************

数字を漢数字に変換 関数

'********************************************************************************************
Function sujikana(moji)
'数字を漢数字に変換

    moji = Replace(moji, "1", "一")
    moji = Replace(moji, "2", "二")
    moji = Replace(moji, "3", "三")
    moji = Replace(moji, "4", "四")
    moji = Replace(moji, "5", "五")
    moji = Replace(moji, "6", "六")
    moji = Replace(moji, "7", "七")
    moji = Replace(moji, "8", "八")
    moji = Replace(moji, "9", "九")
    moji = Replace(moji, "0", "〇")
    moji = Replace(moji, "1", "一")
    moji = Replace(moji, "2", "二")
    moji = Replace(moji, "3", "三")
    moji = Replace(moji, "4", "四")
    moji = Replace(moji, "5", "五")
    moji = Replace(moji, "6", "六")
    moji = Replace(moji, "7", "七")
    moji = Replace(moji, "8", "八")
    moji = Replace(moji, "9", "九")
    moji = Replace(moji, "0", "〇")

    sujikana = moji

End Function
'********************************************************************************************

半角英数字を全角に変換

'********************************************************************************************
Function han_zenkaku(moji)
'半角英数字を全角に変換
moji = Replace(moji, "1", "1")
moji = Replace(moji, "2", "2")
moji = Replace(moji, "3", "3")
moji = Replace(moji, "4", "4")
moji = Replace(moji, "5", "5")
moji = Replace(moji, "6", "6")
moji = Replace(moji, "7", "7")
moji = Replace(moji, "8", "8")
moji = Replace(moji, "9", "9")
moji = Replace(moji, "0", "0")
moji = Replace(moji, "A", "A")
moji = Replace(moji, "B", "B")
moji = Replace(moji, "C", "C")
moji = Replace(moji, "D", "D")
moji = Replace(moji, "E", "E")
moji = Replace(moji, "F", "F")
moji = Replace(moji, "G", "G")
moji = Replace(moji, "H", "H")
moji = Replace(moji, "I", "I")
moji = Replace(moji, "J", "J")
moji = Replace(moji, "K", "K")
moji = Replace(moji, "L", "L")
moji = Replace(moji, "M", "M")
moji = Replace(moji, "N", "N")
moji = Replace(moji, "O", "O")
moji = Replace(moji, "P", "P")
moji = Replace(moji, "Q", "Q")
moji = Replace(moji, "R", "R")
moji = Replace(moji, "S", "S")
moji = Replace(moji, "T", "T")
moji = Replace(moji, "U", "U")
moji = Replace(moji, "V", "V")
moji = Replace(moji, "W", "W")
moji = Replace(moji, "X", "X")
moji = Replace(moji, "Y", "Y")
moji = Replace(moji, "Z", "Z")
moji = Replace(moji, "a", "a")
moji = Replace(moji, "b", "b")
moji = Replace(moji, "c", "c")
moji = Replace(moji, "d", "d")
moji = Replace(moji, "e", "e")
moji = Replace(moji, "f", "f")
moji = Replace(moji, "g", "g")
moji = Replace(moji, "h", "h")
moji = Replace(moji, "i", "i")
moji = Replace(moji, "j", "j")
moji = Replace(moji, "k", "k")
moji = Replace(moji, "l", "l")
moji = Replace(moji, "m", "m")
moji = Replace(moji, "n", "n")
moji = Replace(moji, "o", "o")
moji = Replace(moji, "p", "p")
moji = Replace(moji, "q", "q")
moji = Replace(moji, "r", "r")
moji = Replace(moji, "s", "s")
moji = Replace(moji, "t", "t")
moji = Replace(moji, "u", "u")
moji = Replace(moji, "v", "v")
moji = Replace(moji, "w", "w")
moji = Replace(moji, "x", "x")
moji = Replace(moji, "y", "y")
moji = Replace(moji, "z", "z")
moji = Replace(moji, "-", "ー")
'moji = Replace(moji, " ", " ")

han_zenkaku = moji

End Function
'********************************************************************************************

住所などの最後の F を 階に変換

'********************************************************************************************
Function kai(moji)
 '最後のFを階に変換する
    AAB = ""
    If Not moji = "" Then
        AB = Len(moji)
        AAB = moji
        If AB >= 2 Then
            AC = Mid(moji, AB, 1)
            AD = Mid(moji, 1, AB - 1)
            BC = Mid(moji, AB - 1, 1)
            
            If AC = "F" Or AC = "F" Then
                BC = Replace(BC, "1", "*")
                BC = Replace(BC, "2", "*")
                BC = Replace(BC, "3", "*")
                BC = Replace(BC, "4", "*")
                BC = Replace(BC, "5", "*")
                BC = Replace(BC, "6", "*")
                BC = Replace(BC, "7", "*")
                BC = Replace(BC, "8", "*")
                BC = Replace(BC, "9", "*")
                BC = Replace(BC, "0", "*")
                BC = Replace(BC, "一", "*")
                BC = Replace(BC, "二", "*")
                BC = Replace(BC, "三", "*")
                BC = Replace(BC, "四", "*")
                BC = Replace(BC, "五", "*")
                BC = Replace(BC, "六", "*")
                BC = Replace(BC, "七", "*")
                BC = Replace(BC, "八", "*")
                BC = Replace(BC, "九", "*")
                BC = Replace(BC, "〇", "*")
                BC = Replace(BC, "1", "*")
                BC = Replace(BC, "2", "*")
                BC = Replace(BC, "3", "*")
                BC = Replace(BC, "4", "*")
                BC = Replace(BC, "5", "*")
                BC = Replace(BC, "6", "*")
                BC = Replace(BC, "7", "*")
                BC = Replace(BC, "8", "*")
                BC = Replace(BC, "9", "*")
                BC = Replace(BC, "0", "*")
                If BC = "*" Then
                    AAB = AD + "階"
                End If
            End If
        End If
    End If
    kai = AAB
End Function
'********************************************************************************************

 

 

関連記事