前回までに郵便番号、住所、名前とレイアウトしました。
今日は、会社名をレイアウトそして、肩書もレイアウトするところまで進みます。

前回は、不完全な名前・会社の関数を紹介しました。

・・・・・①　の部分に名前だけの処理を記述してました。

今日は、
会社だけの場合は、・・・・③の部分に
名前と会社有りの場合の会社は、・・・・・・②の部分に
肩書の有る場合は・・・・④の部分に　処理を記述します。

記述の内容は、・・・①　の名前の部分に記述したものとほとんど変わりません。
テキストボックスの配置座標とフォントサイズが流し込むデータが違うぐらいです。
試してください。

 
Function namae_Layout(myWord, docWord, kaisya_DAT, katagaki_DAT, namae_DAT)

    If Not namae_DAT = "" Then
        '名前有り・・・・・・・①
        'ここに名前の記述
        会社が有る無に関わらず､名前は､はがきの中心に配置する

        If Not kaisya_DAT = "" Then
               '名前の有り、会社も有る時
               'ここに、名前有りの時の会社名をレイアウト・・・・会社・・・・②

            If Not katagaki_DAT = "" Then
       
                '肩書有りの場合の肩書書き込み・・・・・・・④
                '肩書は、名前の上に配置、この場合、名前のテキストボックスを少し下げる
                '肩書の中のスペースで改行、多大3行まで　4行以上の場合は、名前横に配置
                '名前の上に配置した肩書のフォントサイズが小さくなった時は、名前の横に配置
            End If
        End If
    Else
        '会社のみの場合の記述、
        '会社内容をはがきの中心にレイアウト・・・・③

    End If

End Function

一番の問題は、肩書有りの処理でしょうか。

前回、レイアウト仕様のお話をしました。

そこで、肩書きは、名前の上に配置
長い時は、名前の右に配置・・・・としました。 

このマクロでは、名前を先に配置してます。
その後、肩書を配置します。
名前の上に固定長のテキスボックスを配置して、肩書データを流し込みます。
この時、溢れ処理を行って、フォントサイズを確認します。
名前の横に配置条件のフォントサイズ値を超えていない場合は、名前のレイアウトと重なる配置のため、テキストボックスを少し下に移動します。
また、フォントサイズが設定値を越えて小さくなった時、肩書のテキストボックスを名前の右に移動します。
肩書は、三行までとしました。肩書データにスペースが有る場合、このスペースで改行するようにしました。

4行の場合は、無条件で名前の右に配置します。

次のスクリプトは、肩書有り・・・・④　に記述した内容です。

 If Not katagaki_DAT = "" Then
         
                '肩書有りの場合の肩書書き込み・・・・・・・④
                
                '肩書は、名前の上に配置、この場合、名前のテキストボックスを少し下げる
                '肩書の中のスペースで改行、多大3行まで　4行以上の場合は、名前横に配置
                '名前の上に配置した肩書のフォントサイズが小さくなった時は、名前の横に配置

                yokokatagaki = 0
                
                katagyo = 1
                katagaki_DAT = katagaki_DAT
            
                katagaki_DAT = sp1_1(katagaki_DAT)
                nm1 = ""
                nm2 = ""
                 nm3 = ""
                sp = InStr(1, katagaki_DAT, " ", 1)

                If Not sp = 0 Then
                    nm1 = Mid(katagaki_DAT, 1, sp - 1)
                    nm2 = Mid(katagaki_DAT, sp + 1)
                    katagyo = 2
                End If
                sp = InStr(1, nm2, " ", 1)
                If Not sp = 0 Then
                    nm3 = Mid(nm2, 1, sp - 1)
                    nm4 = Mid(nm2, sp + 1)
                    katagyo = 3
                End If
                sp = InStr(1, nm4, " ", 1)
                If Not sp = 0 Then
                    katagyo = 4
                End If
                '肩書のスペース部分を　ＣＲコード　改行コード挿入
                katagaki_DAT_H = katagaki_DAT
                If katagyo = 2 Then
                    katagaki_DAT_H = nm1 & vbCr & nm2
                End If
                If katagyo = 3 Then
                    katagaki_DAT_H = nm1 & vbCr & nm3 & vbCr & nm4
                End If

                font_p = 14   '
                Topichi = 26 - 3

                namae_XS = MillimetersToPoints((100 / 2) - ((font_p * 0.35) * katagyo / 2) - 0.5)
                namae_YS = MillimetersToPoints(Topichi)
                XW = MillimetersToPoints((font_p * 0.35) * katagyo + 0.5)
                YH = MillimetersToPoints(23)

                Set TextFramAY = docWord.Shapes.AddTextbox _
   (Orientation:=msoTextOrientationVerticalFarEast, Left:=namae_XS, Top:=namae_YS, Width:=XW, Height:=YH)
                TextFramAY.TextFrame.TextRange.Text = katagaki_DAT_H   'データを書き込む
                TextFramAY.TextFrame.TextRange.Font.Size = font_p
                TextFramAY.TextFrame.TextRange.Font.Name = "HG正楷書体"

                With TextFramAY.TextFrame.TextRange.ParagraphFormat
                    .SpaceBefore = 0    '前のスペース
                    .SpaceBeforeAuto = False
                    .SpaceAfter = 0 '後のスペース
                    .SpaceAfterAuto = False
                    .LineSpacingRule = wdLineSpaceExactly   '行間隔モード
                    .LineSpacing = font_p   '行間隔
                    .Alignment = 4   '揃え方向 0 '揃え方向　　Alignment = 2
                End With

                With TextFramAY.TextFrame
                    .VerticalAnchor = msoAnchorMiddle
                    .MarginBottom = 0
                    .MarginLeft = 0
                    .MarginRight = 0
                    .MarginTop = 0
                End With
            
                TextFramAY.TextFrame.AutoSize = True 'テキストボックスをオートサイズに設定
                TextFramAY.Line.Visible = msoFalse '枠線無しにCreator
                'MsgBox TextFramAN.TextFrame.TextRange.Paragraphs.Count '段落数を調べる
                ' katagyo = 4
                If katagyo <= 3 Then
                        AAAAAA = ovftxtbox(TextFramAY, XW)
                        
                        If TextFramAY.TextFrame.TextRange.Font.Size > 9 Then
                            font_pK = TextFramAN.TextFrame.TextRange.Font.Size
                            namae_YS = TextFramAN.Top 'Yスタート
                            TextFramAN.Top = namae_YS + 24

                            If TextFramAY.TextFrame.TextRange.Paragraphs.Count >= 2 Then '段落数を調べる
                                TextFramAY.TextFrame.TextRange.ParagraphFormat.LineSpacing = TextFramAY.TextFrame.TextRange.Font.Size    '行間隔
                                XWKT = TextFramAY.Width '幅
                                TextFramAY.Left = MillimetersToPoints(100 / 2) - (XWKT)
                            End If
                            
                        Else
                            '肩書横出しフラグセット
                             yokokatagaki = 1
                        End If
                Else
                
                    '肩書横出しフラグセット
                     yokokatagaki = 1
                End If
                
                    'フォントサイズを調査して小さい場合には、名前の横に配置する
                    If yokokatagaki = 1 Then
                    
                        TextFramAY.TextFrame.DeleteText
                        namae_XS = TextFramAN.Left 'Xスタート
                        namae_YS = TextFramAN.Top 'Yスタート
                        XW2 = TextFramAN.Width '幅
                        YH = TextFramAN.Height '高

                        TextFramAY.Left = namae_XS + XW2 'Xスタート
                        TextFramAY.Width = MillimetersToPoints((font_p * 0.35) * 1 + 1)
                        TextFramAY.Top = namae_YS - 5
                        TextFramAY.Height = MillimetersToPoints(148 - Topichi - Botichi) '高
                        TextFramAY.TextFrame.TextRange.Text = katagaki_DAT   'データを書き込む
                        TextFramAY.TextFrame.TextRange.Font.Size = font_p
                        TextFramAY.TextFrame.TextRange.ParagraphFormat.Alignment = 0   '揃え方向 0 '揃え方向　　Alignment = 2
                        '   AAAAAA = ovftxtbox(TextFramAY, XW)
                        TextFramAK.Left = TextFramAY.Left + TextFramAY.Width + 4
                    End If
 
            End If
            
        End If

 ここまでで、当初目的の宛名レイアウトまで来ました。

しかし、ここからが重要です。
色々な住所データでテストをして見てください。
多くの問題が出てくるはずです。

私も、住所データを変えてテストしました。
幾つかの問題が見え、少し訂正しました。

興味のある方は、エクセルデータをダウンロード出来るようにしましたので、試して見てください。

ファイルの拡張子が　.txt　になっています。使用する場合は、.xlsに変えてください。

ハガキ用宛名マクロ＿テスト用.txt　➡　　拡張子を　.xls　に変える

エクセルファイルを開いて、　［開発］⇒　［マクロ］⇒　atena_Rev01　を選択して　［実行］

⇒　ワードが起動して、シート１の住所データをレイアウトして行きます。

少し、時間がかかるかもしれませんが、Wordのレイアウトの動きが見えると思います。

 実行結果のワードデータにハガキの画像を付けて見ました。
ｐｄｆファイルを、画像にリンクしましたので、参照してください。

 年賀状の絵柄をバックにしてみましたが、レイアウト位置を変える必要があるようです。
暑中見舞い等の話も有りますので、早めに見直しておこうと思っています。

少しずつ、完成度を上げて、都度紹介して行きます。

名前のレイアウトの改善

• 連名時の対応
• 会社名に続くセクションを追加
• フォントを変えたい、年賀状にレイアウト等の対応
• 会社名の長さによるレイアウト
• 住所の長さによるレイアウト
• テキストボックスオーバーフロー対応の改善
• 肩書きに対する改善

・・・・・こんなところが今後の課題のように思います。