前回の自動組版（２）では、ロゴ画像のレイアウト方法を紹介しました。
テキストフレームと画像の配置が出来るようになりました。
また、名刺のレイアウト仕様も大雑把ではありますが、決めました。
もう一度、レイアウト仕様を確認します。

テキストの配置は、次のブロック単位で考える事にします。

・部署ブロック　名前の上に配置　３行迄　役員名も含む　下揃え
・肩書ブロック　名前の前に配置　２行までとする　左揃え
・名前ブロック　姓名の文字数により文字間を調整　　
・住所ブロック　名前の下に配置　携帯も含む　５行まで　上揃え
・ロゴ社名ブロック　上側に固定配置　画像を使用

以上の各ブロック全体をレイアウトするスクリプトを記述しました。
次の画像が実行結果です。
全体のレイアウトが見えるようになる所まで来ました。

次回の三栄NAVIから、各項目ごとに考えて行きたいと思います。

以下に、各項目を簡単に紹介します。

テキストフレーム作成　

各ブロック毎に、行数や揃え方向が異なります。
テキストフレームを作成するサブルーチンも行間や揃え方向などが変更できるようにする必要があります。

従って、行間、揃え方向、などの設定機能を追加しました。 

'**************************************************************
'********************　テキストフレーム作成　******************
'**************************************************************
Sub texboxAdd_Y(Data_In,font_IN,font_p,XS,YS,XW,YH,GYOSP,SOROE,UDSOROE)
Rem (書き込むデータ,フォント名,フォントサイズ,Ｘ座標,Ｙ座標,幅,高さ,行間,揃方向,上下揃え方向)
Rem GYOSP    行間を指定します。　最低値はフォントサイズ
Rem SOROE  　揃え方向を指定　先頭０　中１　行末２　両端３　均等割り付け　４
Rem UDSOROE　上下揃え方向　上　１　中　３　下　４

	Set TextFramCall = docWord.Shapes.AddTextbox("1",XS,YS,XW,YH) 'テキストフレーム作成
        TextFramCall.TextFrame.TextRange.Text = Data_In 'データ
        TextFramCall.TextFrame.TextRange.Font.Size = font_p'フォントサイズ
        TextFramCall.TextFrame.TextRange.Font.Name = font_IN '"書体名"

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

     With TextFramCall.TextFrame
       '上下揃えの設定　上＝１　中＝３　下＝４
              .VerticalAnchor = UDSOROE
              .MarginBottom = 0
              .MarginLeft = 0
              .MarginRight = 0
              .MarginTop = 0
     End With
'	TextFramCall.TextFrame.AutoSize = True
	TextFramCall.Line.Visible = msoFalse '枠線無しに
End Sub

'**************************************************************

 今後、複雑な処理に書換えて行く事が予想されます。
従って、各ブロックの処理は、サブルーチンに持って行きました。

メインルーチン

各ブロックの処理をサブルーチンで行うように記述してます。
サブルーチンから戻って来たところで
set TextFramNamae = TextFramCall　の記述してます。

メインルーチンから各ブロックのサブルーチンに移り、テキストフレームが作られて戻って来ます。
そして、次のブロックの処理に移って行くわけですが、その前に、作られたテキストフレームのインスタンスをコピーしておきます。

これは、作られたテキストフレームを後から操作出来るようにするための処理です。

'********　名前　ブロック処理　********************************
call Data_namaeOut_Sub()
set TextFramNamae = TextFramCall'・・・・・インスタンスセット

'**************************************************************
'* 自動組版　Wordで名刺をレイアウト　NO.３　　　　　　　　　　*
'*　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　*
'*　2018-02-20　　　　　　　　　　　　　　　　　　　　　　　　*
'**********************メインルーチン**************************
Dim myWord, docWord
Dim TextFramCall, gzoFramCall
Dim Dat_namae, Dat_Yaku, Dat_Sec1, Dat_Sec2, Dat_Kata
Dim Dat_yubin, Dat_jyusyo, Dat_tel, Dat_fax, Dat_mob, Dat_mail

Set myWord = CreateObject("Word.Application")	' Word 起動
Set docWord = myWord.Documents.Add		 ' 新規ドキュメント作成
myWord.Visible = True ' Word を表示する
'**************************************************************
'********　ドキメントを名刺サイズに　**************************
call DocSizu()
'********名刺データを用意　************************************
call Data_In_Sub()
'********　名前　ブロック処理　********************************
call Data_namaeOut_Sub()
set TextFramNamae = TextFramCall
'********　肩書き　ブロック処理　******************************
call Data_katagakiOut_Sub()
set TextFramkatagaki = TextFramCall
'********　所属ブロック　処理　********************************
call Data_syozokuOut_Sub()
set TextFramSec = TextFramCall
'********　住所等ブロックの処理　******************************
call Data_jyusyoOut_Sub()
set TextFramJyusyo = TextFramCall
'********　社名　ブロック処理　********************************
call Data_syameiOut_Sub()
set TextFramSyamei = TextFramCall
'********　ロゴ画像の配置作成　********************************
call Data_RogoOut_Sub()
set Gazo_RogoTram = gzoFramCall

'**********メインルーチン終わり'*******************************
'**************************************************************

名刺データの用意

名刺のデータは、エクセル等の外部ファイルから取って来る形を考えています。
最終的には、この部分に記述する事になると思います。

全体のレイアウトにめどがつくまでは、このかたちで行きます。

'*****************　名刺データを用意　*************************
Sub Data_In_Sub()
	Dat_namae = "宮本 武蔵"

	Dat_Yaku = ""
	Dat_Sec1 = "総務部"
	Dat_Sec2 = "経理課"

	Dat_Kata = "担当課長"

	Dat_yubin = "142-0053"
	Dat_jyusyo = "東京都品川区中延6-1-29"
	Dat_tel = "03-3785-4402"
	Dat_fax = "03-3785-4401"
	Dat_mob=""
	Dat_mail = "musashi_m"

End Sub

'**************************************************************

 住所ブロック　所属ブロック　正規化

次のスクリプトは、住所ブロックにレイアウトする部分です。
〒マークや、TEL／Fax　等の文字列を追加したり、データの正規化を行うファンクションルーチンを記述してます。
所属ブロックも同様に記述してます。

他の項目でも、この様な正規化のルーチンが、必要になる事が予想されます。

'***********************************************************
'*****************　住所等　ブロック処理　**********************
Sub Data_jyusyoOut_Sub()

	Dat_JyuData= jyuBrock(Dat_yubin,Dat_jyusyo,Dat_tel,Dat_fax,Dat_mob,Dat_mail)

	font_IN = "ＭＳ Ｐゴシック"
	font_p = 8
	XS = MillimetersToPoints(28)
	YS = MillimetersToPoints(38)
	XW = MillimetersToPoints(60)
	YH = font_p * 5
	GYOSP=font_p
	SOROE=0
	UDSOROE=1

	call texboxAdd_Y(Dat_JyuData,font_IN,font_p,XS,YS,XW,YH,GYOSP,SOROE,UDSOROE)

End Sub

'*****************　住所等ブロック　正規化　*********************
Function jyuBrock(Dat_yubin,Dat_jyusyo,Dat_tel,Dat_fax,Dat_mob,Dat_mail)

	jyuBrock = ""
	jyuBrock = "〒" & Dat_yubin & " " & Dat_jyusyo
	jyuBrock = jyuBrock & vbcr & "TEL: " & Dat_tel & "   FAX: " & Dat_fax
	
	if not Dat_mob = "" Then
		jyuBrock = jyuBrock & vbcr & "携帯：" & Dat_mob
	end if

	if not Dat_mail= "" Then
		jyuBrock = jyuBrock & vbcr & "Email：" & Dat_mail & "@sanei-print.co.jp"
	end if
	jyuBrock = jyuBrock & vbcr & "URL:http://www.sanei-print.co.jp"

End Function
'**************************************************************

Mashi_Word 003.vbs　スクリプト全体 

 メモ帳　などにコピーして、実行して見てください。

ロゴの画像ファイルを準備、ファイルパスを書換える必要が有ります。

 必要であれば、　⇒ここ　からダウンロードしてください。

'**************************************************************
'* 自動組版　Wordで名刺をレイアウト　NO.３　　　　　　　　　　*
'*　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　*
'*　2018-02-20　　　　　　　　　　　　　　　　　　　　　　　　*
'**********************メインルーチン**************************
Dim myWord, docWord
Dim TextFramCall, gzoFramCall
Dim Dat_namae, Dat_Yaku, Dat_Sec1, Dat_Sec2, Dat_Kata
Dim Dat_yubin, Dat_jyusyo, Dat_tel, Dat_fax, Dat_mob, Dat_mail

Set myWord = CreateObject("Word.Application")	' Word 起動
Set docWord = myWord.Documents.Add		 ' 新規ドキュメント作成
myWord.Visible = True ' Word を表示する
'
'**************************************************************
'********　ドキメントを名刺サイズに　**************************
call DocSizu()
'********名刺データを用意　************************************
call Data_In_Sub()
'********　名前　ブロック処理　********************************
call Data_namaeOut_Sub()
set TextFramNamae = TextFramCall
'********　肩書き　ブロック処理　******************************
call Data_katagakiOut_Sub()
set TextFramkatagaki = TextFramCall
'********　所属ブロック　処理　********************************
call Data_syozokuOut_Sub()
set TextFramSec = TextFramCall
'********　住所等ブロックの処理　******************************
call Data_jyusyoOut_Sub()
set TextFramJyusyo = TextFramCall
'********　社名　ブロック処理　********************************
call Data_syameiOut_Sub()
set TextFramSyamei = TextFramCall
'********　ロゴ画像の配置作成　********************************
call Data_RogoOut_Sub()
set Gazo_RogoTram = gzoFramCall

'**********メインルーチン終わり'*******************************
'**************************************************************



'**************************************************************
'**************************************************************
'********************　Sub／Function　ルーチン　'**************
'**************************************************************
'**************************************************************

'**************************************************************
'********************　テキストフレーム作成　******************
'**************************************************************

Sub texboxAdd_Y(Data_In,font_IN,font_p,XS,YS,XW,YH,GYOSP,SOROE,UDSOROE)
Rem (書き込むデータ,フォント名,フォントサイズ,Ｘ座標,Ｙ座標,幅,高さ,行間,揃方向,上下揃え方向)
Rem GYOSP    行間を指定します。　最低値はフォントサイズ
Rem SOROE  　揃え方向を指定　先頭０　中１　行末２　両端３　均等割り付け　４
Rem UDSOROE　上下揃え方向　上　１　中　３　下　４

	Set TextFramCall = docWord.Shapes.AddTextbox("1",XS,YS,XW,YH) 'テキストフレーム作成
        TextFramCall.TextFrame.TextRange.Text = Data_In 'データ
        TextFramCall.TextFrame.TextRange.Font.Size = font_p'フォントサイズ
        TextFramCall.TextFrame.TextRange.Font.Name = font_IN '"書体名"

	With TextFramCall.TextFrame.TextRange.ParagraphFormat
        	.SpaceBefore = 0    '前のスペース
        	.SpaceBeforeAuto = False
        	.SpaceAfter = 0 '後のスペース
        	.SpaceAfterAuto = False
        	.LineSpacingRule = 4   '行間隔モード
        	.LineSpacing = GYOSP   '行間隔 fontp
        	.Alignment = SOROE  '揃え方向 0
	End With
	
     With TextFramCall.TextFrame
       '上下揃えの設定　上＝１　中＝３　下＝４
              .VerticalAnchor = UDSOROE
              .MarginBottom = 0
              .MarginLeft = 0
              .MarginRight = 0
              .MarginTop = 0
     End With

'	TextFramCall.TextFrame.AutoSize = True
	TextFramCall.Line.Visible = msoFalse '枠線無しに
End Sub

'**************************************************************
'**************************************************************
'********************　'画像フレーム作成　********************
'**************************************************************
Sub gzoAdd_Y(Gazo_In,XS,YS,XW,YH)
Rem (画像保存場所パス,Ｘ座標,Ｙ座標,幅,高さ)

	Set gzoFramCall = docWord.Shapes.AddTextbox("1",XS,YS,XW,YH) 'テキストフレーム作成
	gzoFramCall.Fill.UserPicture Gazo_In
	gzoFramCall.Line.Visible = msoFalse '枠線無しに
End Sub

'**************************************************************
'*****************　ミリ　⇒　ポイント　変換　****************
Function MillimetersToPoints(mill)
	MillimetersToPoints = mill / 0.35277
End Function
'**************************************************************

'**************************************************************
'*****************　ドキメントサイズを名刺サイズに　***********
Sub DocSizu()
	youshiW = MillimetersToPoints(91)
	youshiH = MillimetersToPoints(55)
	Topichi = 0
	botichi = 0
	Lefichi = 0
	Rigichi = 0

	With docWord.PageSetup
		.TopMargin = Topichi
		.BottomMargin = botichi
		.LeftMargin = Lefichi
		.RightMargin = Rigichi
		.PageWidth = youshiW
		.PageHeight = youshiH
        End With
End Sub

'**************************************************************
'*****************　名刺データを用意　*************************
Sub Data_In_Sub()
	Dat_namae = "宮本 武蔵"

	Dat_Yaku = ""
	Dat_Sec1 = "総務部"
	Dat_Sec2 = "経理課"

	Dat_Kata = "担当課長"

	Dat_yubin = "142-0053"
	Dat_jyusyo = "東京都品川区中延6-1-29"
	Dat_tel = "03-3785-4402"
	Dat_fax = "03-3785-4401"
	Dat_mob=""
	Dat_mail = "musashi_m"

End Sub

'**************************************************************
'*****************　名前　ブロック処理　***********************
Sub Data_namaeOut_Sub()
	font_IN = "HG正楷書体"
	font_p = 18
	XS = MillimetersToPoints(28)
	YS = MillimetersToPoints(25)
	XW = MillimetersToPoints(50)
	YH = font_p + 1
	GYOSP=font_p
	SOROE=0
	UDSOROE=3

	call texboxAdd_Y(Dat_namae,font_IN,font_p,XS,YS,XW,YH,GYOSP,SOROE,UDSOROE)

End Sub


'**************************************************************
'*****************　肩書き　ブロック処理　*********************
Sub Data_katagakiOut_Sub()
	font_IN = "HG正楷書体"
	font_p = 8
	XS = MillimetersToPoints(5)
	YS = MillimetersToPoints(27)
	XW = MillimetersToPoints(20)
	YH = font_p + 1
	GYOSP=font_p
	SOROE=2
	UDSOROE=3

	call texboxAdd_Y(Dat_Kata ,font_IN,font_p,XS,YS,XW,YH,GYOSP,SOROE,UDSOROE)

End Sub

'**************************************************************
'*****************　所属　ブロック処理　***********************
Sub Data_syozokuOut_Sub()

	Dat_SecData= secBrock(Dat_Yaku,Dat_Sec1,Dat_Sec2)

	font_IN = "ＭＳ Ｐ明朝"
	font_p = 8
	XS = MillimetersToPoints(28)
	YS = MillimetersToPoints(15)
	XW = MillimetersToPoints(55)
	YH = font_p * 3
	GYOSP=font_p
	SOROE=0
	UDSOROE=4

	call texboxAdd_Y(Dat_SecData,font_IN,font_p,XS,YS,XW,YH,GYOSP,SOROE,UDSOROE)

End Sub
'*****************　所属ブロック　正規化　***********************
Function secBrock(Dat_Yaku,Dat_Sec1,Dat_Sec2)

	secBrock = ""

	if not Dat_Yaku= "" Then
		secBrock = Dat_Yaku
	end if

	if not Dat_Sec1 = "" Then
		if secBrock = ""  Then
			secBrock =  Dat_Sec1
		else
			secBrock = secBrock & vbcr &  Dat_Sec1
		End if
	end if

	if not Dat_Sec2 = "" Then
		if secBrock = ""  Then
			secBrock =  Dat_Sec2
		else
			secBrock = secBrock & vbcr &  Dat_Sec2
		End if
	end if
End Function
'**************************************************************

'**************************************************************
'*****************　住所等　ブロック処理　**********************
Sub Data_jyusyoOut_Sub()

	Dat_JyuData= jyuBrock(Dat_yubin,Dat_jyusyo,Dat_tel,Dat_fax,Dat_mob,Dat_mail)

	font_IN = "ＭＳ Ｐゴシック"
	font_p = 8
	XS = MillimetersToPoints(28)
	YS = MillimetersToPoints(38)
	XW = MillimetersToPoints(60)
	YH = font_p * 5
	GYOSP=font_p
	SOROE=0
	UDSOROE=1

	call texboxAdd_Y(Dat_JyuData,font_IN,font_p,XS,YS,XW,YH,GYOSP,SOROE,UDSOROE)

End Sub

'*****************　住所等ブロック　正規化　*********************
Function jyuBrock(Dat_yubin,Dat_jyusyo,Dat_tel,Dat_fax,Dat_mob,Dat_mail)

	jyuBrock = ""
	jyuBrock = "〒" & Dat_yubin & " " & Dat_jyusyo
	jyuBrock = jyuBrock & vbcr & "TEL: " & Dat_tel & "   FAX: " & Dat_fax
	
	if not Dat_mob = "" Then
		jyuBrock = jyuBrock & vbcr & "携帯：" & Dat_mob
	end if

	if not Dat_mail= "" Then
		jyuBrock = jyuBrock & vbcr & "Email：" & Dat_mail & "@sanei-print.co.jp"
	end if
	jyuBrock = jyuBrock & vbcr & "URL:http://www.sanei-print.co.jp"

End Function
'**************************************************************

'**************************************************************
'*****************　社名　ブロック処理　**********************
Sub Data_syameiOut_Sub
	font_IN = "ＭＳ Ｐゴシック"
	font_p = 14
	XS = MillimetersToPoints(28)
	YS = MillimetersToPoints(7)
	XW = MillimetersToPoints(55)
	YH = font_p + 1
	GYOSP=font_p
	SOROE=0
	UDSOROE=3

	call texboxAdd_Y("有限会社三栄ぷりんと" ,font_IN,font_p,XS,YS,XW,YH,GYOSP,SOROE,UDSOROE)

End Sub


'**************************************************************
'*****************　ロゴ画像の配置　***************************
Sub Data_RogoOut_Sub()
	XS = MillimetersToPoints(6)
	YS = MillimetersToPoints(4)
	XW = 55.9
	YH = 22.88
	Gazo_In = "C:\Users\sanei\Desktop\三栄ロゴ.png"

	call gzoAdd_Y(Gazo_In,XS,YS,XW,YH)

End Sub
'**************************************************************
'**************************************************************