複数のExcelファイルの印刷設定を一括に変えることはできますか？

質問

1000ブック以上のExcelファイルが手元にありまして、これらの印刷設定をすべて変更しなければならなくなりました。
（実際に印刷はしません。設定をA3横1枚に合わせるだけです）

手作業で1ブックずつやっていくとかなりの手間なのですが、一括で設定を変更し保存する方法はないでしょうか？

なお1ブックにつきSheet1・Sheet2・Sheet3がありますが、
2と3は空シートで、設定を変えたいのはSheet1だけです。
また、必要ならファイル名を連番にすることもできます。

ご教示のほど、よろしくお願いいたします。

回答No.4

mimeu · ベストアンサー

No1.です。
つい、つられて

> (2) 1000ブック以上のExcelファイルは同じフォルダにおき、１からの連番にする。
>　　　例：12.XLS

などと書きましたが、そんなことをする必要はありません。
少しわかりにくいですが、本文を以下のようにすれば元のファイル名のままで処理できます。

Sub 大量ブックの印刷書式を変更()
　　Const パス = "A:\Bcde\ナントカカントカ\" ' ★★★ 実際の名前に直して下さい ★★★
　　Dim ファイル名 As String
　　ファイル名 = Dir(パス & "*.xls")
　　Do While ファイル名 <> ""
　　　　ブック毎に印刷設定を変更 パス & ファイル名
　　　　ファイル名 = Dir()
　　Loop
End Sub

※ なお、もしブックの中に Sheet1 を持たないものがあれば
そこでエラーになります。その場合はエラー対応のロジックを追加する必要があります。

お礼

ご丁寧にありがとうございます！
とても助かりました。

回答No.3

keithin

回答２は、ごめんなさい、ほかのご質問への回答を投稿してしまいました。
大変失礼しました。

ちなみにこちらのご質問では、
１．新しいマクロの記録で１つ、サンプルのブックのページ設定変更操作をマクロに記録する
　　記録先は「個人用マクロブック」に
　　ショートカットキーを登録しておくとよい
　　上書き保存してブックを閉じるところまでマクロにとる

２．対象ブックをどんどん開いて、１で記録したマクロをショートカットキーでばしばしと走らせる

ぐらいの感じでも。

＃ただし
実際には、ページ設定の操作を自動記録マクロに録ると、よけいなアクションまで記録されてしまって応答の遅いマクロになります。
マクロを編集し、必要な命令だけに抜き出して実行させるとベターです。

お礼

ありがとうございます！
そうか、マクロ記録でもできるんですね・・・。

回答No.2

keithin

手順の組み立ては次のとおりになります。

１．マスタシートのＡ列の上から下までのセルをFor Next巡回する
２．各セルのＣ列が１でなかったらスルーする、１なら次の作業を行う
３．各列のＡＤＥ列のセルの内容を、雛形シートの所定のセルに転記する
４．拾ったマクロでアドレス設定、メールの本文整形、Outlookで送出まで行う
５．１に戻って繰り返す。

サンプル：
sub Macro1()
dim h as range

’１
for each h in worksheets("宛先マスタ").range("A2:A" & worksheets("宛先マスタ").range("A65536").end(xlup).row)

’２
if h.offset(0, 2) = 1 then

’３
worksheets("送信文章").range("A17") = h
worksheets("送信文章").range("A18") = h.offset(0, 3)
worksheets("送信文章").range("A19") = h.offset(0, 4)

’４
　メール本文の生成と送出

’５
End If
Next

End Sub

回答No.1

mimeu

もしＶＢＡを使ってよければ、これでいいと思います。

前提条件は以下の４点です。
(1) 任意のブックに下記プログラムをコピーする。
　　もしその方法をご存じなければ、また質問して下さい。
(2) 1000ブック以上のExcelファイルは同じフォルダにおき、１からの連番にする。
　　　例：12.XLS
(3) 通常使うプリンターはＡ３サイズが使えるものに指定しておく。
(4) 試す前に、かならずバックアップを取る。

Sub 大量ブックの印刷書式を変更()
　　Const パス = "A:\Bcde\ナントカカントカ\" ' ★★★ 実際の名前に直して下さい ★★★
　　Dim 繰返し As Integer
　　For 繰返し = 1 To 1000 ' ★★★ 実際の数に直して下さい ★★★
　　ブック毎に印刷設定を変更 パス & 繰返し & ".xls"
　　Next 繰返し
End Sub

Sub ブック毎に印刷設定を変更(ブック名 As String)
　　Dim ブック As Workbook
　　Set ブック = Application.Workbooks.Open(ブック名)
　　With ブック.Worksheets("Sheet1").PageSetup
　　　　.Orientation = xlLandscape
　　　　.PaperSize = xlPaperA3
　　End With
　　ブック.Save
　　ブック.Close
End Sub