宛名印刷
2017/03/06
エクセルからワードの宛名をレイアウトする。住所をレイアウト
管理者用
いよいよ住所に入りました。
まず縦書きなので、算用数字は、漢数字変換しましょう。
住所データには、ビル等の情報も有ります。
どのようにするのか、検討する必要があります。
縦書きの宛名としてますから、まずは、書き出し位置を決めます。
はがきの右側の縁から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
住所データが長く、テキストボックスをはみ出すような状況になった場合に、何らかの処理が必要になります。
今回、何とかして対応策を検討したのですが、残念ながら解決策は、見つかってません。
まだ、試行錯誤状態です。
テキストボックスをオーバーフローしているか、判断の方法が見つかっていないのです。
最悪、フォントサイズと文字数の計算で、対応する事も考えています。
とりあえず、このまま先に進めて行きます。
・・・・どうなる事やら!