TOP > blog > エクセルからワードの宛名をレイアウトする。住所をレイアウト
word
2017/03/06

エクセルからワードの宛名をレイアウトする。住所をレイアウト

管理者用
blog

いよいよ住所に入りました。
まず縦書きなので、算用数字は、漢数字変換しましょう。
住所データには、ビル等の情報も有ります。
どのようにするのか、検討する必要があります。

縦書きの宛名としてますから、まずは、書き出し位置を決めます。
はがきの右側の縁から10mmの位置を端にしました。
上は、郵便番号から10mm下をスタート位置として、下は、15mm程度空けたレイアウトにします。

メインのスクリプトです。
前回までのものに、住所をレイアウトする部分を追加しただけです。
その、住所レイアウトも、関数化しました。


Sub atena_jyusyo()
    Dim myWord As New Word.Application         ' Word 起動
    Dim docWord As Document
    
    Set myWord = CreateObject("Word.Application")
    Set docWord = myWord.Documents.Add
    Set docSelec = myWord.Selection
    myWord.Visible = True ' Word を表示する
    '******************************************************
    Rem   ブックのサイズをはがきサイズに ========
    CC = yoshi_size(docWord, "はがき")
    '******************************************************
    MaxGyo = Range("A1").End(xlDown).Row '行数 データ件数を調べる

    For Ab = 1 To MaxGyo - 2 'データ分のページ作成
        docSelec.InsertNewPage
    Next
    
    docSelec.GoTo What:=wdGoToPage, Which:=1  '1ページに移動

    For gyoNo = 1 To MaxGyo - 1

        yubin_DAT = Sheet1.Cells(gyoNo + 1, 5)
        jyusyo1_DAT = Sheet1.Cells(gyoNo + 1, 6)
        jyusyo2_DAT = Sheet1.Cells(gyoNo + 1, 7)
        
        '******************************************************
        Rem  郵便番号の配置
        If Not yubin_DAT = "" Then
            yubin_DAT = yubin_del(yubin_DAT) '郵便番号の正規化
            AA = yubin_Layout(docWord, yubin_DAT) '郵便番号のレイアウト
        End If
        '******************************************************
        Rem  住所の配置
        AA = jyusyo_Layout(docWord, jyusyo1_DAT, jyusyo2_DAT)  '住所のレイアウト
        '******************************************************
        docSelec.GoTo What:=wdGoToPage, Which:=wdGoToNext
    Next
End Sub

サンプル住所データを少し変えています。 

 実行結果 ハガキサイズに、住所をレイアウトしました

 

住所が2行になる場合は、2行目を下揃えに設定します。

住所のレイアウト部分を関数化にしました。


Function jyusyo_Layout(docWord, jyusyo1_DAT, jyusyo2_DAT)
        Rem  住所の配置
        jyusyo_DAT = ""
        jyusyo_Gyuo = 0
       
        If Not jyusyo1_DAT = "" Then
                If Not jyusyo2_DAT = "" Then
                    jyusyo_DAT = jyusyo1_DAT & vbCr & jyusyo2_DAT
                    jyusyo_Gyuo = 2
                  
                Else
                    jyusyo_DAT = jyusyo1_DAT
                    jyusyo_Gyuo = 1
                    
                End If
        Else
                jyusyo_DAT = jyusyo2_DAT
                jyusyo_Gyuo = 1
        End If
        
        jyusyo_DAT = sujikana(jyusyo_DAT)
        jyusyo_DAT = mainasu(jyusyo_DAT)
 
        font_p = 18 '
        Topichi = 26
        Botichi = 15
        RENDichi = 10
        
        jyusyo_XS = MillimetersToPoints(100 - RENDichi - (font_p * 0.35) * 2 - 1)
        jyusyo_YS = MillimetersToPoints(Topichi)
        XW = MillimetersToPoints((font_p * 0.35) * 2 + 1)
        YH = MillimetersToPoints(148 - Topichi - Botichi)

       Set TextFramAJ = docWord.Shapes.AddTextbox _
   (Orientation:=msoTextOrientationVerticalFarEast, Left:=jyusyo_XS, Top:=jyusyo_YS, Width:=XW, Height:=YH)
        TextFramAJ.TextFrame.TextRange.Text = jyusyo_DAT 'データを書き込む
        TextFramAJ.TextFrame.TextRange.Font.Size = font_p
        TextFramAJ.TextFrame.TextRange.Font.Name = "HG正楷書体"
    
    With TextFramAJ.TextFrame.TextRange.ParagraphFormat
        .SpaceBefore = 0    '前のスペース
        .SpaceBeforeAuto = False
        .SpaceAfter = 0 '後のスペース
        .SpaceAfterAuto = False
        .LineSpacingRule = wdLineSpaceExactly   '行間隔モード
        .LineSpacing = font_p   '行間隔
        .Alignment = 0 '揃え方向
    End With

    With TextFramAJ.TextFrame
       .VerticalAnchor = msoAnchorTop
       .MarginBottom = 0
       .MarginLeft = 0
       .MarginRight = 0
       .MarginTop = 0
    End With
    
    If jyusyo_Gyuo = 2 Then
        TextFramAJ.TextFrame.TextRange.Sentences(2).ParagraphFormat.Alignment = 2
    End If
    
        TextFramAJ.Line.Visible = msoFalse '枠線無しにCreator
        
    jyusyo_Layout = 1
    
End Function

漢数字への正規化のい方法は色々考えられますが、単純な形にしています。
この様な、正規化のスクリプトは、色々な場面で使えます。

Function sujikana(moji)
	moji = StrConv(moji, 4)
	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 mainasu(moji)
	moji = Replace(moji, "ー", "ー")
	moji = Replace(moji, "‐", "ー")
	moji = Replace(moji, "-", "ー")
	moji = Replace(moji, "―", "ー")
	moji = Replace(moji, "-", "ー")
	moji = Replace(moji, "-", "ー")
	mainasu = moji
End Function

住所データが長く、テキストボックスをはみ出すような状況になった場合に、何らかの処理が必要になります。
今回、何とかして対応策を検討したのですが、残念ながら解決策は、見つかってません。
まだ、試行錯誤状態です。

テキストボックスをオーバーフローしているか、判断の方法が見つかっていないのです。

最悪、フォントサイズと文字数の計算で、対応する事も考えています。

とりあえず、このまま先に進めて行きます。

・・・・どうなる事やら!

 

関連記事