kaemi回答ポイントなし

Excel2016で複数ブックの複数シートを一括でページ設定を変更したいです。

500近いExcelのブックがあるのですが、パソコンを変えたところ、ページ設定がずれてしまい印刷がうまくいかない状態になってしまいました。
ページ設定で、1×1に収まるように設定したいのですが数が多いため、いろいろと調べて下記のようなVBSを見つけ調整しました。
ページ設定を変えたいシートは「提出」を含むシートなのですが、1つのブックに「提出」を含むシートが複数あると止まってしまいます。
この場合、どうしたらよいのでしょうか？

Option Explicit
Dim a, b, v, w, x, y, z
MsgBox("Start!")
Set v = CreateObject("Scripting.FileSystemObject")
Set w = v.GetFolder(".")
Set x = CreateObject("Excel.Application")
x.Application.DisplayAlerts = False
x.Visible = True
For Each a In w.Files
b = LCase(v.GetExtensionName(a.Name))
If b = "xls" or b = "xlsx" Then
Set y = x.Workbooks.Open(w & "\" & a.Name)
Set z = y.Worksheets("*提出*")
With z.PageSetup
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
End With
y.SaveAs(w & "\" & a.Name)
y.Close
Set z = Nothing
Set y = Nothing
End If
Next
x.Quit
Set x = Nothing
Set w = Nothing

ログインして回答する

ベストアンサー

きむむ2018/11/05 23:37:03
”複数あると止まってしまう”とはどんなものかわからないのですが、では１個だけなら処理できるということのようですが、当方で試したところ、ワークシート名を"*提出*" で判定する処理はエラーとなって全く実行できませんでした。
それからシートは複数あるのも普通のことでしょうから、ここはシートを一つずつ順番に処理する形になるでしょう。
つまりシートの数分を、もう一段の For Each で処理することになります。
また、"*提出*"に相当する部分は、Instr関数で、シート名に含んでいるかを判定することにして、以下のようにしてみました。
どうでしょうか。
```
Option Explicit
Dim a, b, v, w, x, y, z
    MsgBox ("Start!")
    Set v = CreateObject("Scripting.FileSystemObject")
    Set w = v.GetFolder(".")
    Set x = CreateObject("Excel.Application")
    x.Application.DisplayAlerts = False
    x.Visible = True
    For Each a In w.Files
        b = LCase(v.GetExtensionName(a.Name))
        If b = "xls" Or b = "xlsx" Then
            Set y = x.Workbooks.Open(w & "\" & a.Name)
           'Set z = y.Worksheets("*提出*")         ' ←当方では、このワイルドカードは働かなかった

' =================
' ワークシートを一つずづ確認
For Each z In y.Worksheets
  ' シート名に"提出"を含むものを対象として処理
  If Instr(z.Name,"提出")>0 then
            With z.PageSetup
                .Zoom = False
                .FitToPagesWide = 1
                .FitToPagesTall = 1
            End With
  End if
Next
' =================

            y.SaveAs (w & "\" & a.Name)
            y.Close
            Set z = Nothing
            Set y = Nothing
        End If
    Next
    x.Quit
    Set x = Nothing
    Set w = Nothing
```
後はちょっと思うところですが、
SaveAsはどんなものだろうかと。
Saveで良いようにおもうけれど、保存先の指定が不要だし。
そして変更のないブックは上書き保存もしない方が気分としては良いので、変更状況を見てSaveを行うとか。
また処理状況をログとしてテキストファイルに書き出すのも確認に有効です。
でもまあ、一度限りの処理だと思うので手間かけるまでもないのでしょう。
スター
- 1件のコメントを見る
- kaemi 2018/11/06 10:28:47
  
  ご教授、ありがとうございます。
  教えていただいたもので、できるようになりました。
  保存に関しましては、ご指摘の通り1度限りなので、このまま実施させていただこうと思います。
  
  スター

その他の回答

空腹おやじ2018/11/05 23:09:54

WorkSheetの指定をワイルドカードを使用しているのが問題のような気がします。

Set z = y.Worksheets("*提出*")

For Eachを使って、ワークシートの名前を個別にチェックして、処理対象のシートの場合のみ処理して、処理済みの場合は最後に保存すればよいのでは？

変数名を変えてありますが、こんな感じで出来ませんか？

        If sExtention = "xls" Or sExtention = "xlsx" Then
            Set wb = xlApp.Workbooks.Open(fld.Path & "\" & fl.Name)

            mustSave = False

            For Each ws In wb.Worksheets
                If ws.Name Like "*提出*" Then
                    With ws.PageSetup
                        .Zoom = False
                        .FitToPagesWide = 1
                        .FitToPagesTall = 1
                    End With

                    mustSave = True
                End If
            Next ws

            If mustSave Then
                wb.SaveAs (fld.Path & "\" & fl.Name)
            End If

            wb.Close

            Set wb = Nothing
        End If

スター

1件のコメントを見る
kaemi 2018/11/06 10:27:42

ご教授、ありがとうございます。
ファイル操作を繰り返す中に、シートの操作の繰り返しを入れるイメージでしょうか。
やってみます！

スター

Excel2016で複数ブックの複数シートを一括でページ設定を変更したいです。

ベストアンサー

きむむ2018/11/05 23:37:03

kaemi 2018/11/06 10:28:47

その他の回答

空腹おやじ2018/11/05 23:09:54

kaemi 2018/11/06 10:27:42

この質問へのコメント

この質問への反応（ブックマークコメント）

質問の情報

この質問のカテゴリ

この質問に含まれるキーワード

人気の質問

メニュー

PC版