TOP > blog > エクセルからワードの宛名をレイアウトする。ページ追加処理
宛名印刷
2017/03/01

エクセルからワードの宛名をレイアウトする。ページ追加処理

管理者用
blog

前回、郵便番号の処理まで進みました。
他の情報もレイアウトしたいのですが、その前に、住所データ1件に対し、1ページとして処理して行く必要があります。

私自身、どうしたら良いのか、なにか良い方法が無いのか思考錯誤の状態です。
テキストブロックを使って、レイアウトして行く方法で進めてます。
処理を次のページに移していく時、改行/ページ追加等の処理を行います。
ページに対してのカーソル位置で改行します。この事も試行錯誤の原因の一つですが、もう一つページの移動処理が思うようにコントロール出来ない事が上げられます。

なにか良い方法が無いか模索中です。
それまでの間、次のような処理で行う事としました。

必要ページ数を先に作っておいてから、1ページに戻り、1行1ページの順にレイアウトして行く方法です。
しばらくは、この方法で行きたいと思います。

次のサンプルマクロ yubin_Roopでは、住所データを5件に増やしましたので、5ページの郵便番号レイアウト行います。

前回の郵便番号レイアウト処理部分を関数化して、少しすっきりしたスクリプトになりました。
合わせて、これらの関数も紹介しておきます。

Sub yubin_Roop()

    Dim myWord As New Word.Application         ' Word 起動
    Dim docWord As Document
   ' Dim docSelection
    
    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)
        '******************************************************
        Rem  郵便番号の配置 関数化してます

        If Not yubin_DAT = "" Then
            yubin_DAT = yubin_del(yubin_DAT) '郵便番号の正規化
            AA = yubin_Layout(docWord, yubin_DAT) '郵便番号のレイアウト
        End If
        Rem 郵便番号の配置 END
        '******************************************************

        docSelec.GoTo What:=wdGoToPage, Which:=wdGoToNext
        
    Next
End Sub

サンプル住所データです。5件に増やしてます。 

 実行結果 ハガキサイズに、郵便番号の部分だけですが、5ページがレイアウトされました。

 

 わかりやすい画像を得るために、5ページの宛名をPDFファイルに書き出しました。

 

 <関数の紹介>

前回のNAVIで紹介した郵便番号の書き込み部分を関数化しました。


Function yubin_Box(docWord, yubin_X1_ich, yubin_YS_ichaa, Me_yubin_mojikan, YH, yubin_DAT)

    Set TextFramA1 = docWord.Shapes.AddTextbox _
   (Orientation:=msoTextOrientationHorizontalRotatedFarEast, Left:=yubin_X1_ich, Top:=yubin_YS_ichaa, Width:=Me_yubin_mojikan, Height:=YH)
        TextFramA1.TextFrame.TextRange.Text = Mid(yubin_DAT, 1, 1) 'データを書き込む
        TextFramA1.TextFrame.TextRange.Font.Size = 14
        TextFramA1.TextFrame.TextRange.Font.Name = "MS ゴシック (見出しのフォント - 日本語)"
    
    With TextFramA1.TextFrame.TextRange.ParagraphFormat
        .SpaceBefore = 0    '前のスペース
        .SpaceBeforeAuto = False
        .SpaceAfter = 0 '後のスペース
        .SpaceAfterAuto = False
        .LineSpacingRule = wdLineSpaceExactly   '行間隔モード
        .LineSpacing = 10   '行間隔
        .Alignment = wdAlignParagraphCenter   '揃え方向
    End With

    With TextFramA1.TextFrame
       .VerticalAnchor = msoAnchorMiddle
       .MarginBottom = 0
       .MarginLeft = 0
       .MarginRight = 0
       .MarginTop = 0
    End With
    
        TextFramA1.Line.Visible = msoFalse '枠線無しに
        
    yubin_Box = 1
    
End Function

yubin_Box関数でメインマクロが多少見やすくなったのですが、さらに、関数 yubin_Box に渡すレイアウト座標の処理している部分も関数化しました。
これで、メインのマクロは、すっきり見やすくなったと思います。

Function yubin_Write(docWord, yubin_DAT)
        yubin_font = "MS ゴシック" 'MS ゴシック
        yubin_fontW = "Regular"
        font_p = 14 '14p
        
        YH = font_p * 0.35 + 3
         YH = MillimetersToPoints(YH)
        
        YW = font_p * 0.35 + 1
        Me_yubin_mojikan = 7
         Me_yubin_mojikan = MillimetersToPoints(Me_yubin_mojikan)
         
        yubin_X1_ich = MillimetersToPoints(44 - 0) '+ Me_size_OFX 44
        yubin_X2_ich = yubin_X1_ich + Me_yubin_mojikan '7
        yubin_X3_ich = yubin_X2_ich + Me_yubin_mojikan '7
        yubin_X4_ich = yubin_X3_ich + Me_yubin_mojikan * 1.086 '7.6 'Me_yubin_mojikan*1.086
        yubin_X5_ich = yubin_X4_ich + Me_yubin_mojikan * 0.971 '6.8 'x0.971
        yubin_X6_ich = yubin_X5_ich + Me_yubin_mojikan * 0.971 '6.8
        yubin_X7_ich = yubin_X6_ich + Me_yubin_mojikan * 0.971 '6.8
        
        Me_yubin_YS = MillimetersToPoints(11.5 - 0)
        yubin_YS_ichaa = Me_yubin_YS
        
        '-----------------1桁
        AA = yubin_Box(docWord, yubin_X1_ich, yubin_YS_ichaa, Me_yubin_mojikan, YH, Mid(yubin_DAT, 1, 1))
        '-----------------2桁
        AA = yubin_Box(docWord, yubin_X2_ich, yubin_YS_ichaa, Me_yubin_mojikan, YH, Mid(yubin_DAT, 2, 1))
        '-----------------3桁
        AA = yubin_Box(docWord, yubin_X3_ich, yubin_YS_ichaa, Me_yubin_mojikan, YH, Mid(yubin_DAT, 3, 1))
        '-----------------4桁
        AA = yubin_Box(docWord, yubin_X4_ich, yubin_YS_ichaa, Me_yubin_mojikan, YH, Mid(yubin_DAT, 4, 1))
        '-----------------5桁
        AA = yubin_Box(docWord, yubin_X5_ich, yubin_YS_ichaa, Me_yubin_mojikan, YH, Mid(yubin_DAT, 5, 1))
        '-----------------6桁
        AA = yubin_Box(docWord, yubin_X6_ich, yubin_YS_ichaa, Me_yubin_mojikan, YH, Mid(yubin_DAT, 6, 1))
        '-----------------7桁
        AA = yubin_Box(docWord, yubin_X7_ich, yubin_YS_ichaa, Me_yubin_mojikan, YH, Mid(yubin_DAT, 7, 1))
        
   End Function

ついでに、用紙サイズを設定している部分も関数化しました。
はがきサイズにのみの対応ですが、他で使うときには、訂正する必要があります。


Function yoshi_size(docWord, youshimei)

    youshimei = "はがき"
    
    If youshimei = "はがき" Then
    
        With docWord.PageSetup
            .PageWidth = MillimetersToPoints(100)
            .PageHeight = MillimetersToPoints(148)
            .LeftMargin = MillimetersToPoints(5)
            .RightMargin = MillimetersToPoints(5)
            .TopMargin = MillimetersToPoints(5)
            .BottomMargin = MillimetersToPoints(5)
        End With
    
    End If
    yoshi_size = (0)
    
End Function

以上、内容的には、ページ処理の話でしたが、スクリプトの載せているので、ページ的には長くなってしまいました。
ご了解ください。

関連記事