エクセルマクロによる大量ファイルの一括印刷方法

質問

Excel 2007の印刷マクロについて御教示ください。
＜実行したいこと＞
○　数百に及ぶエクセルファイル(すべて単一シートからなる同一セル構成)を、逐一個別のファイルを開いて印刷するのではなく、一度だけエクセルをロードして一挙にこれらを印刷したい。
＜環境・条件＞
・印刷したいファイル名称は、D:\FILENAMES.TXTに、1ファイル一行単位で記録されている。
　D:\DATA\01A001.XLS
　D:\DATA\01A002.XLS
　D:\DATA\02A010.XLS
　　　　…
・印刷の順序は、D:\FILENAMES.TXTに書き込まれているとおりとする。
・各エクセルファイルは、すべて単一シートの構成である。
・使用するエクセルは2007、OSはWinXP

※　エクスプローラで印刷したいエクセルファイル名を名称の上昇順に表示させ、これらを一括して範囲指定し右クリックして印刷を指定すると印刷はできますが、印刷の順序が必ずしも上昇順ではなくなってしまい、私の場合この機能は使えません。エクセルのマクロで処理するのが適当なのではないかと考えていますが、エクセルのマクロは使ったことがありません。よろしくお願いします。

回答No.3

Wendy02 · ベストアンサー

こんにちは。

>エクセルのマクロは使ったことがありません。

VB系のプログラミングの経験はあるのでしょうか？もし、ご存知ないようでしたら、どこかのサイトで、設定の仕方とか調べてください。生のコードを扱うには、基本的な知識が必要です。

また。この手のマクロというのは、PCの周辺状況の見えない部分があるので、実際には100個のファイルをきちんと処理できるか分かりません。いきなり実行せずに、プレビューやファイル数を減らし、試験的にやってみて、行けると思ったら、本格的にマクロを実行してください。

一応、プリンタのオプションとして、Wait を入れてみました。Wait は、印刷には直接関係ありませんが、マクロは一旦中断されます。印刷の命令が速過ぎて、印刷が遅い場合、プリンタ・バッファに溜まりすぎてしまうのを、防ぐためのものです。

Application.Wait Now + TimeSerial(0, 0, 3) '3秒　←この部分で、一つのファイルを印刷する平均的な時間を入れてあげると、PCの負担が少なくてすみます。

プリンタの性能にもよりますが、出来れば、100個のファイルを一気に印刷せずに、30個ぐらいに分散したほうが安全です。

'-------------------------------------------

Sub TestMacro1()
　　Dim fName As String
　　Dim fNo As Integer
　　Dim TextLine As String
　　Dim ArFNames() As String
　　Dim i As Long, j As Long
　　Dim fn As Variant
　　''-------------------------------------------
　　fName = Application.GetOpenFilename("テキストファイル(*.txt),*.txt")
　　If VarType(fName) = vbBoolean Then Exit Sub
　　''-------------------------------------------
　　'fName = "D:\FILENAMES.TXT"　'固定ファイルなら上の2行は不要

　　fNo = FreeFile()
　　Open fName For Input As #fNo
　　Do While Not EOF(fNo)
　　　　Line Input #fNo, TextLine
　　　　If Len(TextLine) > 2 Then
　　　　　　ReDim Preserve ArFNames(i)
　　　　　　ArFNames(i) = Trim(TextLine)
　　　　　　i = i + 1
　　　　End If
　　Loop
　　Close #fNo
　　'印刷
　　Application.Calculation = xlCalculationManual
　　On Error Resume Next
　　For Each fn In ArFNames
　　　　If Dir(fn) <> "" Then
　　　　　　With Workbooks.Open(fn)
　　　　　　　　If Err.Number = 0 Then
　　　　　　　　　　'プレビューを入れる場合、「'」を外す
　　　　　　　　　　.ActiveSheet.PrintOut 'Preview:=True
　　　　　　　　　　j = j + 1
　　　　　　　　　　.Close False
　　　　　　　　　　''プリンタの性能によって、ウェイトを3秒入れる
　　　　　　　　　　''ウェイトを入れる場合は「'」を外す
　　　　　　　　　　'Application.Wait Now + TimeSerial(0, 0, 3)
　　　　　　　　　　Err.Clear
　　　　　　　　End If
　　　　　　End With
　　　　End If
　　Next fn
　　On Error GoTo 0
　　Application.Calculation = xlCalculationAutomatic
　　MsgBox j & " 個のファイルを処理しました。", vbInformation
End Sub

お礼

詳細なアドバイス、ありがとうございました。
すったもんだした挙げ句、諸般の事情によりこの処理は沙汰やみとなりました。
なお、マクロは参考とさせていただきます。
お礼が遅れて申し訳ありません。重ね重ねありがとうございました。