dポイントプレゼントキャンペーン実施中!

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

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

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


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

A 回答 (4件)

No1.です。


つい、つられて

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

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

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

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

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

お礼日時:2010/03/18 12:20

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


大変失礼しました。


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

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

ぐらいの感じでも。

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

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

お礼日時:2010/03/18 12:22

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



1.マスタシートのA列の上から下までのセルをFor Next巡回する
2.各セルのC列が1でなかったらスルーする、1なら次の作業を行う
3.各列のADE列のセルの内容を、雛形シートの所定のセルに転記する
4.拾ったマクロでアドレス設定、メールの本文整形、Outlookで送出まで行う
5.1に戻って繰り返す。



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

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

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

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

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

’5
End If
Next

End Sub
    • good
    • 1

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



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

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています