TOP > blog > 名刺をWordで作る VBスクリプト(vbs)で自動組版(4)
スクリプト
2018/02/23

名刺をWordで作る VBスクリプト(vbs)で自動組版(4)

管理者用
blog

前回の 自動組版(3) で、全体のレイアウトまで書きました。
しかし、テキストボックスに垂れ流しの大雑把なものです。
今回から、名刺の各要素のレイアウトに絞って考えて行きます。
紹介するスクリプトは、名前ブロック処理 の部分だけです。
他の部分は、前回の内容を参照してください。
尚、名前を変えてテストする手前、 名刺データを用意 のサブルーチンは、都度、変更してます。

前回の 名前ブロック処理サブルーチンです。


'***************** 名前 ブロック処理 ***********************
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
'**************************************************************

 

名前のレイアウト方法には、幾つか考えられます。

名前のレイアウト方法には、幾つか考えられます。
どちらにしても、姓名が区分け出来る事が必要です。

揃え方向
 先頭揃え
 中央揃え
 両端揃え
 末揃え

文字間の調整
 姓名の文字数により、スペースを空ける
 スペースを空ける方法には、スペース文字を挿入する
 両端揃えで空ける
 
等が考えられます。

1年ほど前に、エクセルからワードで宛名レイアウトについて紹介した事がありますが、この中では、
姓名の文字数によるスペース文字を入れる方法で紹介してました。

今回は、Wordの文字間調整機能を使って行って見ます。

Word 文字間隔 調整方法

ホーム ⇒ フォントグループ 右下の→ クリック
⇒ 詳細設定タブ   文字間隔で調整

Vbsの記述

テキストブロック全体


TextFramNamae.TextFrame.TextRange.Font.Spacing = 10

特定文字に対する場合 ・・・例では2番目の文字


TextFramNamae.TextFrame.TextRange.Characters.Item(2).Font.Spacing = 20

 

文字間隔値と実際

まだ研究不足の点もありますが、文字間隔の指定値と実際を紹介しておきます。

テキストボックスに、宮本武蔵 18ポイントの指定で書き込みました。
上から、
  間隔値  0 ポイント
  間隔値  6 (1/3ポイント)
  間隔値  9 (1/2ポイント)
  間隔値 18 ポイント

以上の事から、
1文字分の間隔値 1/2ポイント
2文字      1ポイント
となるようです。

プロポーショナルフォントとスペース

今回の話からは、若干離れますが、スペース文字を入れて文字間隔を調整する場合には注意が必要です。
特に、プロポーショナルフォントでは、大きく変わってきます。
次に紹介した画像は、どちらの宮本武蔵の文字間にスペースを入れてます。

上が MS明朝
下が MSP明朝

文字間調整 スクリプトの流れ

実際の 「名前 ブロック処理」 スクリプト全体は、最後に紹介してます。

名前は、姓名の間にスペースが入っている事が条件となってます。

スペースを区切り文字として姓名の文字数を調べる
姓名を分けているスペースを取り除く
テキストフレームに書き込む
姓名の文字数により文字間を調整する

Case を使って、姓名の文字数により文字間隔を設定します。
例では 姓 2文字  名2文字 の場合を紹介。

 


Select Case len_1
	Case 1
	Case 2
		Select Case len_2
			Case 1
			Case 2
				TextFramNamae.TextFrame.TextRange.Font.Spacing =  font_p * 2/6
				TextFramNamae.TextFrame.TextRange.Characters.Item(2).Font.Spacing = font_p * 2/4
				TextFramNamae.TextFrame.TextRange.Characters.Item(4).Font.Spacing = 0
			Case 3
			Case Else
		End Select
	Case 3
	Case Else
End Select

 

「名前 ブロック処理」 スクリプト

スクリプト全体は、前回を参照してください。
この中の、名前 ブロック処理の部分を以下に紹介してます。
スクリプト全体から、この部分を入れ替えて下さい。

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


'*********************************************************
'***************** 名前 ブロック処理 ***********************
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

	'***** 姓名文字数調査 ****
	moji=Dat_namae
	moji = LTrim(moji)   '両端スペース削除
	moji = RTrim(moji)
	sp = InStr(1, moji, " ", 1)

	If sp = 0 Then
		nm1 = moji
		nm2 = ""
	Else
		nm1 = Mid(moji, 1, sp - 1)
		nm2 = Mid(moji, sp + 1)
	End If

	nm1 = LTrim(nm1)   '両端スペース削除
	nm1 = RTrim(nm1)
	nm2 = LTrim(nm2)   '両端スペース削除
	nm2 = RTrim(nm2)
	len_1 = Len(nm1)
	len_2 = Len(nm2)

	Dat_namae =nm1 & nm2

	call texboxAdd_Y(Dat_namae,font_IN,font_p,XS,YS,XW,YH,GYOSP,SOROE,UDSOROE)
	set TextFramNamae = TextFramCall


	Select Case len_1
		Case 1
			Select Case len_2
				Case 1
					TextFramNamae.TextFrame.TextRange.Font.Spacing = font_p
					TextFramNamae.TextFrame.TextRange.Characters.Item(2).Font.Spacing = 0
				Case 2
					TextFramNamae.TextFrame.TextRange.Font.Spacing = font_p / 2
					TextFramNamae.TextFrame.TextRange.Characters.Item(1).Font.Spacing = font_p
					TextFramNamae.TextFrame.TextRange.Characters.Item(3).Font.Spacing = 0
				Case 3
					TextFramNamae.TextFrame.TextRange.Font.Spacing = font_p * 1/10
					TextFramNamae.TextFrame.TextRange.Characters.Item(1).Font.Spacing = font_p * 2/3
					TextFramNamae.TextFrame.TextRange.Characters.Item(4).Font.Spacing = 0
				Case Else
					TextFramNamae.TextFrame.TextRange.Font.Spacing = 1
					TextFramNamae.TextFrame.TextRange.Characters.Item(1).Font.Spacing = font_p * 1/3

			End Select
		Case 2
			Select Case len_2
				Case 1
					TextFramNamae.TextFrame.TextRange.Font.Spacing = font_p / 2
					TextFramNamae.TextFrame.TextRange.Characters.Item(2).Font.Spacing =font_p 
					TextFramNamae.TextFrame.TextRange.Characters.Item(3).Font.Spacing = 0
				Case 2
					TextFramNamae.TextFrame.TextRange.Font.Spacing = font_p' * 2/6
					'TextFramNamae.TextFrame.TextRange.Characters.Item(2).Font.Spacing = font_p * 2/4
					'TextFramNamae.TextFrame.TextRange.Characters.Item(4).Font.Spacing = 0
				Case 3
					TextFramNamae.TextFrame.TextRange.Font.Spacing = font_p * 1/10
					TextFramNamae.TextFrame.TextRange.Characters.Item(1).Font.Spacing = font_p * 3/10
					TextFramNamae.TextFrame.TextRange.Characters.Item(2).Font.Spacing = font_p * 4/10
					TextFramNamae.TextFrame.TextRange.Characters.Item(5).Font.Spacing = 0
				Case Else
					'TextFramNamae.TextFrame.TextRange.Font.Spacing = font_p * 1/10
					'TextFramNamae.TextFrame.TextRange.Characters.Item(2).Font.Spacing = font_p * 3/10

			End Select
		Case 3
			Select Case len_2
				Case 1
					TextFramNamae.TextFrame.TextRange.Font.Spacing = font_p * 1/10
					TextFramNamae.TextFrame.TextRange.Characters.Item(3).Font.Spacing = font_p * 2/3
				Case 2
					TextFramNamae.TextFrame.TextRange.Font.Spacing = font_p * 1/10
					TextFramNamae.TextFrame.TextRange.Characters.Item(3).Font.Spacing =font_p * 4/10
					TextFramNamae.TextFrame.TextRange.Characters.Item(4).Font.Spacing =font_p * 3/10
					TextFramNamae.TextFrame.TextRange.Characters.Item(5).Font.Spacing = 0
				Case 3
					TextFramNamae.TextFrame.TextRange.Font.Spacing =0
					TextFramNamae.TextFrame.TextRange.Characters.Item(3).Font.Spacing =font_p * 3/10
					TextFramNamae.TextFrame.TextRange.Characters.Item(6).Font.Spacing = 0
				Case Else
					TextFramNamae.TextFrame.TextRange.Font.Spacing = 0
					TextFramNamae.TextFrame.TextRange.Characters.Item(3).Font.Spacing = font_p * 1/10
			End Select
		Case Else

	End Select

End Sub

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

 

 

 

関連記事