今回で、ｖｂｓを使用した、Wordで名刺を作成する　を終わります。

エクセルからデータを貰い、名刺らしいものが作る事が出来ました。
スクリプトを動かし、Wordに組版して行く様子を見ていると、自動組版やってるって実感がわきます。

私自身、Wordをあまり理解してませんが、その文書機能には、関心する事が多いです。
しかし、印刷関係の方々は、Wordを組版ソフトとして見ていないようです。
その原因が、細かなレイアウトコントロールがやりにくい点も一つの要因と思われます。

その問題を解決ためには、テキストブロックでレイアウトして行くと、少しは改善すると考えます。
と言う事で、名刺のレイアウトをテキストブロックを使ってレイアウトしました。
・・・・出来ると言うのが実感です。
貴方はどう思いますか？

Word、Excel　VBAで行う方が良いと思う時が有ります。
わざわざVBSを使う必要は無いのでは、と言う方もいられるかもしれません。
しかし、詳しい話は別にして、ＶＢＳの方が運用面で有効です。

簡単な名刺の自動組版でしたが、他のものにも、色々な形で応用が利くと思います。
今回使用した、スクリプトを抜き出し、まとめて紹介しておきます。

ワードを開く

Set myWord = CreateObject("Word.Application") ' Word 起動
myWord.Visible = True ' Word を表示する

新規ドキュメント作成

Set docWord = myWord.Documents.Add		 ' 新規ドキュメント作成

ドキメントサイズを設定

'*****************　ドキメントサイズを名刺サイズに　***********
	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

テキストボックス（テキストフレーム）

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

TextFramNamae.TextFrame.TextRange.Font.Spacing = font_p * 1/10
TextFramNamae.TextFrame.TextRange.Characters.Item(3).Font.Spacing =font_p * 4/10

       '上下揃えの設定　上＝１　中＝３　下＝４
     With TextFramCall.TextFrame
              .VerticalAnchor = UDSOROE
              .MarginBottom = 0
              .MarginLeft = 0
              .MarginRight = 0
              .MarginTop = 0
     End With

font_J = TextFramJyusyo.TextFrame.TextRange.Font.Size'・・・フォントサイズ取得
TextFramJyusyo.TextFrame.TextRange.ParagraphFormat.LineSpacing = font_J + (font_J * 5 / 10) '・・・・取得したフォントサイズから行間隔

ＴＡＢの設定

TextFramJyusyo.TextFrame.TextRange.ParagraphFormat.TabStops.ClearAll
set tabAA = TextFramJyusyo.TextFrame.TextRange.ParagraphFormat.TabStops.Add(MillimetersToPoints(6.5))

タブの種類

tabAA. Alignment = 0

'wdAlignTabBar = 4 
'wdAlignTabCenter = 1 
'wdAlignTabDecimal = 3 
'wdAlignTabLeft = 0 
'wdAlignTabList = 6 
'wdAlignTabRight = 2

リーダー

tabAA. Leader = 0

6種類から選択可

wdTabLeaderDashes = 2 ---
wdTabLeaderDots = 1 ....
wdTabLeaderHeavy = 4_____
wdTabLeaderLines = 3 ____
wdTabLeaderMiddleDot = 5 ･････
wdTabLeaderSpaces = 0

画像ファイルの配置

     Set gzoFramCall = docWord.Shapes.AddTextbox("1",XS,YS,XW,YH) '・・・テキストフレーム作成
	gzoFramCall.Fill.UserPicture "画像ファイル"
	gzoFramCall.Line.Visible = 0 '・・・・・枠線無しに

ドキメントを保存／ＰＤＦファイルで保存

SevDirWord = "C:\Users\sanei\Desktop" 'フォイルダー
SevFileMei = SevDirWord & "\" & Dat_namae & ".docx" '保存ファイル名　名前を使用
PDF_FileMei = SevDirWord & "\" & Dat_namae & ".pdf" 'ＰＤＦファイル名　名前を使用

docWord.SaveAs2 SevFileMei '・・・・保存
docWord.ExportAsFixedFormat PDF_FileMei,17,False '・・・・・ＰＤＦファイル保存

エクセルファイルを開く

Set objExcel = WScript.CreateObject("Excel.Application") 
Set exlBook = objExcel.WorkBooks.Open("C:\Users\sanei\Desktop\meishiDATA.xls") 
Set exlSheet = exlBook.WorkSheets("Sheet1")

Excl_DATA = exlSheet.Cells(2,4) '・・・・読み取る
exlSheet.Cells(2,4) = Excl_DATA '・・・・書き込む

クローズ処理

　　　　　docWord.Close 'ファイルを閉じる
	　　myWord.Quit() 'ワードを閉じる
　　　　　objExcel.Quit()'エクセルを閉じる

ファイルシステム操作

今回のスクリプト中では、本vbsファイルのフォルダーのパスを取得するだけに使用しました。
VBSを自動化に使用する場合、ファイルシステムの操作が不可欠となります。
別途、何らかの形で紹介したいと思います。

'本スクリプトのディレクトリーパスの取得
Set objFSO = CreateObject("Scripting.FileSystemObject")
CentPasuDesu = objFSO.getParentFolderName(WScript.ScriptFullName)
Set objFSO = Nothing

ミリ ポイント　変換

　　ワードの中で使用する寸法等の値は、ポイント表記です。
　１ポイントは 0.35mm<の概算で出すことが出来ますが、少し荒いようです。
　Word VBAで用意されている、単位変換関数を　VBSでも同じ名前の関数化しておきました。

　下５桁での計算しているので、文字の組版レベルでは十分な正確さです。

Function MillimetersToPoints(mill)
	MillimetersToPoints = mill / 0.35277
End Function