(何番煎じだ! とか言わないで)
はじめに
大量のExcelファイルを一括印刷したいとき、エクスプローラで一括選択してから右クリック、「印刷」で出来るかなと思っていたけども
選択するファイルが多くなってくると「印刷」メニューそのものが出てこないことが分かった。
一個一個開いて印刷するのは超面倒なので何とかならないか考えた。
動作確認環境
- Windows 10 Pro
- Microsoft Office 2010/2013
コード
Excel一括印刷
Option Explicit
' 確認メッセージ
If MsgBox("このプログラムと同じフォルダにあるExcelファイルを全て印刷します。よろしいですか?", vbYesNo + vbExclamation) = vbNo Then
WScript.Quit
End If
' ファイルシステムオブジェクトの生成
dim fso
set fso = createObject("Scripting.FileSystemObject")
' スクリプトが存在するフォルダパスを取得
dim scriptdir
scriptdir = fso.getParentFolderName(WScript.ScriptFullName)
' Excelを起動
dim objExcel
set objExcel = CreateObject("Excel.Application")
objExcel.Application.Visible = false ' Excelを不可視状態とする
dim file
dim ext
for each file in scriptdir.files
ext = fso.GetExtensionName(file)
' ファイル名がテンポラリファイル(~$で始まらない)でなく、拡張子がExcelっぽかったらExcelで開いてみる
if (Left(fso.getBaseName(file), 2) <> "~$") AND ((ext = "xls") OR (ext = "xlsx")) then
objExcel.Workbooks.Open(file)
' 1番目のシートをアクティブにする
objExcel.Worksheets(1).Activate
' アクティブなシートを印刷する
objExcel.ActiveWindow.ActiveSheet.PrintOut
' 開いたExcelブックを保存する場合は↓のコメントアウトを外す
'objExcel.Workbooks(1).Save
' 開いたExcelブックを保存する場合は↓の「False」を外す。Falseだと保存せず閉じる
objExcel.Workbooks(1).Close False
end if
next
' Excelを終了し、オブジェクトを解放する
objExcel.quit()
Set objExcel = Nothing
msgbox("印刷ジョブを送信しました")
上記コードをメモ帳等にコピペし、拡張子「.vbs
」でExcelファイルのあるフォルダに保存。
あとはそのファイルをダブルクリックして実行するだけ。
このコードだけで言うとワークシート内のデータをいじったわけではないので、保存せず閉じても支障ないのかなと思っている。
既知の問題、Tips
-
処理中にExcelを起動するとバグる
非表示にしていたものが表示されてしまい、処理が正常に進まなかったり操作ができなくなったりする。 -
各ブックの全シートを印刷したい時はさらに改造が必要
「シートのアクティブ化」→「シートの印刷」 を存在するシート分繰り返す必要がある。