Excelの印刷マクロについて

質問

Excelにて、1枚のシートに他のブックの全てのシートの名称を記述し、選択したシート全てを印刷するマクロを組みたいと考えています。
数日前から考えているのですが、検討が付かず困っています。
何方かご教授願えれば幸いです。
よろしくお願いします。

回答No.2

keithin

どういう作業の段取りを考えているのですか？イマイチ不明です。

たとえば。
１．（どこにあるか不明の）複数のブックの全てのシート名をマクロで調査記述させたい？
　　それとも既にリストアップは完了しているところから始めたい？
２．リストを手動でコントロール＋クリッククリック等しながら飛び飛び選択したい？
３．選択したセルのシートを次々印刷したい（これは明らかなようです）

１については既出回答もありますし，既にリストアップは出来ているものとします。
２については手作業です。
ただし，作成したリストには必ず「ブック名.拡張子」と「シート名」が列記されているとします。仮にA列とB列に。
ブックの保存場所は既知であるとします。（仮にC:\test\内）

Sub macro1()
　Dim h As Range
　Application.ScreenUpdating = False
　On Error Resume Next
　For Each h In Application.Intersect(Range("A:A"), Selection.EntireRow)
　　With Workbooks.Open(Filename:="c:\test\" & h)
　　　.Worksheets(h.Offset(0, 1).Value).PrintOut
　　　.Close False
　　End With
　Next
　Application.ScreenUpdating = True
End Sub

回答No.1

merlionXX

一例です。

このマクロを書いたBOOKが保存されているフォルダー内のBOOKを対象にします。
マクロを書いたBOOKのSheet1に転記します。
拡張子はxlsとします。

Sub test01()
Application.ScreenUpdating = False '画面更新を一時停止
Set mb = ThisWorkbook 'このコピー先ブックをmbとする。
myfdr = ThisWorkbook.Path
fname = Dir(myfdr & "\*.xls") 'フォルダ内のExcelブックを検索
Do Until fname = Empty '全て検索
If fname <> mb.Name Then 'ブック名がこのブックの名前でなければ
Set wb = Workbooks.Open(myfdr & "\" & fname) 'そのブックを開きwbとする。
For Each ws In wb.Worksheets
n = n + 1
mb.Sheets("Sheet1").Cells(n, "A").Value = ws.Name 'シート名転記
mb.Sheets("Sheet1").Cells(n, "B").Value = wb.Name 'ブック名転記
Next ws
End If
wb.Close (False) '閉じる
fname = Dir 'フォルダ内の次のExcelブックを検索
Loop '繰り返す
Application.ScreenUpdating = True '画面更新一時停止を解除
MsgBox n & "件のシート名をコピーしましました。プリントします。"
ActiveWindow.SelectedSheets.PrintOut
End Sub