VBSでEXCELの両面印刷を可能にする方法

2020年10月14日2024年4月3日

毎朝キレイなコスモスが咲いている道路を通って通勤しています。気分いいですねぇ。

Contents

1. やりたいこと：VBSで複数のEXCELファイルを両面印刷したい
2. ネットで見つかる一般的な方法
3. 秘技：VBSでEXCEL両面設定する

やりたいこと：VBSで複数のEXCELファイルを両面印刷したい

なのです。EXCELの30ファイルぐらいを、ひとつずつ開いて、両面印刷設定を確認して、複数枚ずつ印刷する作業をコツコツやると結構な時間がかかります。これを楽に、正確に作業できるようにしたいというお題があるのです。

ネットで見つかる一般的な方法

印刷対象の EXCELファイルのプリンタ設定、両面設定しておいてVBSで連続印刷する

だめ～

うまくいきません。なぜかVBSで開くと両面設定が飛んでしまいます。私の環境だけでしょうかね。。

このお題は、2年ぐらい解決策が見つからなかったのですが、中々よさげなアイデアが浮かびました。実際調子よくツールは調子よく動作しています。

秘技：VBSでEXCEL両面設定する

たどり着いた実現可能な方法 (概略)

両面設定したEXCELのテンプレートファイルを用意する。
VBSでテンプレートファイルを開く
印刷対象のEXCELファイルを開いて、テンプレートファイルに貼り付ける
印刷対象のEXCELファイルの改ページ位置、印刷倍率をテンプレートファイルに設定する
印刷する

大成功！！

無理なので回避策を見つけたというのが正確なところです。4.の手順で改ページ位置、倍率をテンプレートファイルに設定しています。他にも必要な設定があれば、同様の要領で設定すればOKです。ちなみに、私が必要とする作業は改ページ位置が１つだけしか出てこない書類です。複数の改ページ位置がある場合はカスタマイズしてください。

CreateObject("Scripting.FileSystemObject")
Set t_folder = f_obj.GetFolder(".\PRINTOUT")
Set c_foldert = f_obj.GetFolder(".")
Set xl1 = CreateObject("Excel.Application")
xl1.Application.DisplayAlerts = False
xl1.Visible = True
Set template_book = xl1.Workbooks.Open(c_foldert &amp; "\" &amp; "PrintSheet.xlsx")	' テンプレートファイルを開く
Set template_sheet = template_book.Worksheets(1)
template_sheet.Select
For Each a In t_folder.Files
	ext = LCase(f_obj.GetExtensionName(a.Name))								' 拡張子を切り出す
	
	If ext = "xls" or ext = "xlsx"  Then									' EXCELの拡張子は印字
		Set prt_book = xl1.Workbooks.Open(t_folder &amp; "\" &amp; a.Name)			' 印刷対象ファイルを開く
		prt_book.Worksheets(1).Select										' 印刷対象ファイルをアクティベート
		
		w_pb1 = xl1.ActiveSheet.HPageBreaks(1).Location.Address				' 最初の改ページ位置を保存
		
        w_zoom = xl1.ActiveSheet.PageSetup.Zoom								' 印刷倍率を保存
		xl1.Cells.Font.Color = RGB(0,0,0)									' 塗りつぶしなし(私の場合必要)
		xl1.Cells.copy														' 
		template_book.Activate												' テンプレートファイルをアクティベート
		xl1.Cells.PasteSpecial(-4104)										' 全貼りつけ
		xl1.Cells.copy														' 
		xl1.Cells.PasteSpecial(-4163)										' 値貼りつけ
		xl1.ActiveSheet.HPageBreaks(1).Delete								' 1つ目の改ページ位置を削除
		xl1.ActiveSheet.Range(w_pb1).PageBreak = -4135						' 改ページ位置を設定 -4135：xlPageBreakManual
		template_sheet.PageSetup.zoom = w_zoom								' 印刷倍率設定
		template_sheet.PageSetup.BlackAndWhite = True						' 白黒印刷(必要に応じて)
		template_sheet.PrintOut ,,2											' 印刷、2枚指定
		prt_book.Close														' 印刷対象のファイルを閉じる
	End If
Next
template_book.Close
xl1.Quit
Set Template_bppl = Nothing
Set xl1 = Nothing
Set current = Nothing
Set target = Nothing
Set p_sheet  = Nothing

実際のコードは上記の1.～5.の手順の通りではないです。多少前後している所があります。細かいところはソースコードで確認してください。

VBSファイルと同じ階層に、テンプレートファイル：PrintSheet.xlsxをおく。
印刷対象のEXCELファイルはPIRNTOUTフォルダに入れておく。

ん～右端のコメントの桁位置がずれる。。。。

LevUP

Posted by ozxys