エクセル マクロ セル内にあるシート名のシートを複数指定印刷

エクセルマクロについて質問があります。
自分では実力不足で作れないため助けていただきたいです。

〇　Sheet1のセルA1からA5までにシート名の入力項目がある
〇　Sheet2以降は"月"、"火"、"水"、"木"、"金"、"土"、"日"という名前のシートがある
〇　例としてSheet1のセルA1に"月"、A2に"水"、A3に"金"と入力する (A4、A5は空欄)

この時、マクロを実行すると
入力名のシートだけをすべて選択して印刷するというマクロはどうなるか教えていただきたいです。
入力する項目はいろいろ変わります。

よろしくお願いいたします。

質問者からの補足コメント

• 印刷はPDFにしたいため、WindowsのプリンターをPDFに設定し、一つ一つの印刷ではなく、指定シートを選択してすべてを一つのファイルとして保存したいと考えています。

    補足日時：2017/02/03 10:51

No.4 回答者： ママチャリ 回答日時： 2017/02/06 13:58

No.3です。

Sheet1のセルA1からA5に、実際に存在しないシート名が入力されていませんか？
または、見た目は空白でもスペースがひとつ入っている等でもエラーになります。

No.2のお礼の中に「ファイル名を元Excelファイル名と同じにしたい」という要件が書かれていますが、Microsoft Print To PDFでは、都度、ファイル名の指定が必要になってしまいます。よって、No.2さんの方式の方が応用が利くので便利かもしれません。

この回答へのお礼

ありがとうございます。
必要のないスペースがありました。修正すると印刷することができました。

様々な方法が勉強になり本当に助かりました。この場でしか教えていただく方法がないため、またわからないことがありましたら、力を貸してください。よろしくお願いします。
ありがとうございました。

お礼日時：2017/02/06 16:38

No.3 回答者： ママチャリ 回答日時： 2017/02/04 09:16

通常使うプリンターに、Microsoft Print To PDFを指定するということなので、マクロでのPDF化は意識しなくて良いと云うことですよね。

であれば、こんな感じでどうでしょう。
（tom04さん、すいません！！VBAコードは、tom04さんの最初の案のパクリです。）

Sub Sample1()
Dim i As Long
Dim k As Variant
With Worksheets("Sheet1")
For i = 1 To 5
If .Cells(i, "A") <> "" Then
If k <> "" Then k = k & "!"
k = k & .Cells(i, "A")
End If
Next i
End With
Worksheets(Split(k, "!")).PrintOut
End Sub

この回答へのお礼

回答ありがとうございます。
マクロでのPDF化は意識しなくて良いという考えは、正しくその通りです。

記述していただいたものを実行したところ
Worksheets(Split(k, "!")).PrintOut
のところで「ｲﾝﾃﾞｯｸｽが有効範囲にありません。」
となりました。この場合はどうしたらよいでしょうか？

お礼日時：2017/02/06 09:55

No.2 ベストアンサー 回答者： tom04 回答日時： 2017/02/03 11:37

No.1です。

＞指定シートを選択してすべてを一つのファイルとして保存したいと考えています。

選択Sheet（印刷プレビューで表示されたSheetだけ）を別ファイル（PDFファイル）として保存するのが一番手っ取り早いのではないでしょうか？

Sub Sample2()
Dim i As Long, k As Long, cnt As Long
Dim wB1 As Workbook, wB2 As Workbook
Set wB1 = ThisWorkbook
Workbooks.Add
Set wB2 = ActiveWorkbook
With wB1.Worksheets("Sheet1")
For i = 1 To 5
If .Cells(i, "A") <> "" Then
For k = 2 To wB1.Worksheets.Count
If wB1.Worksheets(k).Name = .Cells(i, "A") Then
cnt = cnt + 1
If wB2.Worksheets.Count < cnt Then
wB2.Worksheets.Add after:=wB2.Worksheets(Worksheets.Count)
End If
wB1.Worksheets(k).Cells.Copy wB2.Worksheets(cnt).Range("A1")
wB2.Worksheets(cnt).PrintPreview
Exit For
End If
Next k
End If
Next i
End With
wB2.ExportAsFixedFormat Type:=xlTypePDF, Filename:="PDFファイル"
'↑「PDFファイル」という名前で保存//
Application.DisplayAlerts = False
wB2.Close
Application.DisplayAlerts = True
End Sub

※　おそらくマイドキュメントに「PDFファイル」という名前で保存されていると思います。
ファイル名は適宜変更してください。

当方の力ではこの程度しか思いつきません。m(_ _)m

この回答へのお礼

引き続きの回答ありがとうございます。
一番の目的である指定シートを一つにということができました。

まだちなみになのですが...
マイドキュメントに「PDFファイル」というところを。元のエクセルファイル名と同じにという指定ができますでしょうか？？
Filename:="PDFファイル"のところをどうにか変えるのだろうな..ということしかわかりません(/ω＼)

お礼日時：2017/02/06 09:52

No.1 回答者： tom04 回答日時： 2017/02/02 19:07

こんばんは！

一例です。
標準モジュールにしてください。

Sub Sample1()
Dim i As Long, k As Long
With Worksheets("Sheet1")
For i = 1 To 5
If .Cells(i, "A") <> "" Then
For k = 2 To Worksheets.Count
If Worksheets(k).Name = .Cells(i, "A") Then
Worksheets(k).PrintPreview '←印刷プレビューでやめています//
Exit For
End If
Next k
End If
Next i
End With
End Sub

※　コード内に記載しているように「印刷プレビュー」でやめています。
すぐに印刷実行したい場合は
＞Worksheets(k).PrintOut
にしてください。m(_ _)m

この回答へのお礼

すごいです。できました！！
どうも丁寧にありがとうございました。

ちなみにWindowsのプリンタの設定をPDFにして印刷した場合に一つ一つの保存ではなくて、印刷シートすべてを一ファイルのような形にしたいのですが、そのようなことも可能でしょうか？？

お礼日時：2017/02/03 10:47