エクセルからワードの宛名をレイアウトする。ページ追加処理
管理者用
前回、郵便番号の処理まで進みました。
他の情報もレイアウトしたいのですが、その前に、住所データ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
以上、内容的には、ページ処理の話でしたが、スクリプトの載せているので、ページ的には長くなってしまいました。
ご了解ください。