ワードで宛名のレイアウトを行う。それもエクセルからコントロールする・・・・・・
と始めましたが、前回で予定した宛名項目のレイアウトまでたどりつきました。

それなりに使える様な気がしますが、色々なデータで試して見ると、多くの課題が見られます。

もう少し完成度を上げて、使えるものにしていきたいと、さらに進める事にしました。
今までの続きと言うことですので、前回までのNAVIも参照してください。

今日は、テキストボックスの溢れ処理（オーバーフロー）について考えて見ます。

テキストボックスのオーバーフローを検出する方法を考えてきましたが、ようやく見つける事が出来ました。
この事は、数日前のNAVIの中で紹介してます。

テキストボックスにデータを流し込み、想定される、テキストボックスの幅より広がった時、溢れていると判断できる。
この事を発見した時、Wordを宛名レイアウトで使える様にしようと本当に思うようになりました。
実は、半信半疑で進めていたのです。

話を本題に戻します。
溢れていると判断したら、フォントサイズを小さくして溢れを解消します。

なるべくフォントサイズを落とすと言うのは避けたいと思いますので
文字間隔を詰める。
フォントを平体にして行く。
・・・・・・についても考えたいと思います。
また、テキストボックスを広げて行く方法も上げられますが、全体の配置も考慮する必要があり、難しそうです。

・・・・・って事で、溢れ処理を3種用意しました。

次の図は、会社名をレイアウトしたものです。
それぞれの溢れ処理を試して見ました。
ポイントと平体の数字も参照してください。

A・・・溢れて2行に（元の状態）
B・・・フォントサイズを落として溢れ解消
C・・・平体をかけて溢れ解消
D・・・文字間を狭めて溢れ解消
E・・・手作業で調整

平体のレイアウトは、どうでしょうか。
あまり違和感なく感じられるのではと思います。
極端に平たくなるようでは、問題ですが、使える感じです。
フォントサイズを落とすより、良いかもしれません。

文字間を狭めて行く方法は、使い方が難しそうです。

この三つの方法を組み合わせた溢れ処理を考える必要が有りそうです。
そして、項目毎の対応が必要のようです。

次の図は、名前の上に配置する肩書きのレイアウト例です。

まず、文字間隔を少し狭める、平体をかける、フォントサイズを落とす。
どこまで、・・・・と言ったところが課題です。
また、住所・社名・名前・肩書それぞれに対し合った組み合わせを考える必要が有りそうです。

スクリプトサンプル例
文字フォントを小さくして行く方法

 
Function ovftxtbox(TextFramAN, XW)
    XW2 = TextFramAN.Width '幅
    font_p = TextFramAN.TextFrame.TextRange.Font.Size
    ovftxtbox = 0
     If XW2 > XW + 1 Then
        ovftxtbox = 1
        font_pZ = font_p
    End If
 'オーバーフローしているか調査、　フォントサイズを小さくする
    Do While ovftxtbox = 1
        font_pZ = font_pZ - 0.5
        TextFramAN.TextFrame.TextRange.Font.Size = font_pZ
        XW2 = TextFramAN.Width
        
        If XW2 <= XW Then
            ovftxtbox = 0
            Exit Do
        End If
    Loop
End Function

スクリプトサンプル例
平体をかけて行く方法、パーセンテージで指定します。
どこまで平たくしていくのか、条件の設定も必要です。

Function ovftxtboxB(TextFramAN, XW)
    XW2 = TextFramAN.Width '幅
    ovftxtboxB = 0
    If XW2 > XW + 1 Then
        ovftxtboxB = 1
        font_ScalingZ = 100
    End If
   
 'オーバーフローしているか調査、　フォントに平体をかける
    Do While ovftxtboxB = 1
        font_ScalingZ = font_ScalingZ - 1
        TextFramAN.TextFrame.TextRange.Font.Scaling = font_ScalingZ
        XW2 = TextFramAN.Width
        
        If XW2 <= XW Then
            ovftxtboxB = 0
            Exit Do
        End If
    Loop
End Function

スクリプトサンプル例
文字間を詰める

文字同士が重なり合うようでは、問題です。

使っているフォントによっても、変わって来るので、使い方は難しそうです。

Function ovftxtboxC(TextFramAN, XW)
    XW2 = TextFramAN.Width '幅
    font_p = TextFramAN.TextFrame.TextRange.Font.Size
    ovftxtboxC = 0
    If XW2 > XW + 1 Then
        ovftxtboxC = 1
        FontSpacingZ = font_p
    End If
   
 'オーバーフローしているか調査、　文字間を狭める
    Do While ovftxtboxC = 1
        XW2 = TextFramAN.Width '幅
        FontSpacingZ = FontSpacingZ - 0.5
        TextFramAN.TextFrame.TextRange.Font.Spacing = FontSpacingZ
        XW2 = TextFramAN.Width
        
        If XW2 <= XW Then
            ovftxtboxC = 0
            Exit Do
        End If
    Loop
End Function

 フォント、平体、文字間をまとめて関数にしました。
初めに平体から入るようにしました。平体は、８０％まで、
続いて、フォントは６ポイントまで、最後は文字間ですが、制限を設定してません。

Function ovftxtbox(TextFramAN, XW)

    XW2 = TextFramAN.Width '幅
    
    ovftxtbox = 0
    If XW2 > XW + 1 Then
        ovftxtbox = 1
        font_ScalingZ = 100
    End If
   
 'オーバーフローしているか調査、　フォントに平体をかける
 
    Do While ovftxtbox = 1
    
        If font_ScalingZ > 80 Then
            font_ScalingZ = font_ScalingZ - 1
            TextFramAN.TextFrame.TextRange.Font.Scaling = font_ScalingZ
            XW2 = TextFramAN.Width
        
            If XW2 <= XW Then
                ovftxtbox = 0
                Exit Do
            End If
            
        Else
              Exit Do
        End If
    Loop

    font_p = TextFramAN.TextFrame.TextRange.Font.Size
    ovftxtbox = 0
     If XW2 > XW + 1 Then
        ovftxtbox = 1
        font_pZ = font_p
    End If
 'オーバーフローしているか調査、　フォントサイズを小さくする
    Do While ovftxtbox = 1
        font_pZ = font_pZ - 0.5
        
        If font_pZ > 6 Then
        
            TextFramAN.TextFrame.TextRange.Font.Size = font_pZ
            XW2 = TextFramAN.Width
        
            If XW2 <= XW Then
                ovftxtbox = 0
                Exit Do
            End If
                    
        Else
            Exit Do

        End If
    Loop

    font_p = TextFramAN.TextFrame.TextRange.Font.Size
    ovftxtbox = 0
    If XW2 > XW + 1 Then
        ovftxtbox = 1
        FontSpacingZ = font_p
    End If
   
 'オーバーフローしているか調査、　文字間を狭める
    Do While ovftxtbox = 1
        FontSpacingZ = FontSpacingZ - 0.5
        'TextFramAN.TextFrame.TextRange.Font.Size = font_pZ
        TextFramAN.TextFrame.TextRange.Font.Spacing = FontSpacingZ
        XW2 = TextFramAN.Width
        
        If XW2 <= XW Then
            ovftxtbox = 0
            Exit Do
        End If
    Loop
End Function

宛名印刷全体のスクリプトは、前回のＮＡＶＩからダウンロードできます。
この関数に入れ替えて、試して見てください。