名刺をWordで作る VBスクリプト(vbs)で自動組版(4)
管理者用前回の 自動組版(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
'**************************************************************