エクセル マクロで印刷

質問

• エクセルのマクロを利用して、複数のシートを一括で印刷する方法を教えてください。
• エクセルBookの目次に複数のシート名を作成し、目次から選択して印刷できるようにする方法を教えてください。
• エクセルBookのSheet 1に他のBookのフルパスを入れ、目次から印刷することができるマクロの作成方法を教えてください。

回答No.7

HohoPapa · ベストアンサー

後記コードです。
印刷ダイアログでキャンセルしたら、空振りするようにしました。
実在しないシート名が指定された場合は
メッセージを表示して終了するようにしました。

>2番目の課題はご指摘の通り別の質問にします。
>これが出来れば課題１は不要の気がします。
>が、いきなり2番目では（当方にも）難しいかと思い２段階にしたのですが。。。
>１．が出来る人には同じ事、ですかね？？？？

２ができれば１は不要と思いますが、
１を少し手直しすれば２になるということはありません。
どのブックたちを対象にするかの制御部分は流用できますが、
問題は、
個々のブックに含まれるそれぞれの複数シートの中から
どのシートたちを対象にするのかを選択させるインターフェース部分です。

常識的には、添付画像のようなフォームを使うことになりますが
失礼ながら、このサイトでコードを受け取り
少々修正して使うレベルでは、歯が立ちません。

どのシートたちを対象にするのかのインターフェース部分を
どのように実現するかをしっかり考える必要があり、
フォームを使うのであれば、一段のスキルアップが必要です。

Option Explicit

Sub Sample1()

　With ThisWorkbook.Sheets(1)

　　Const DataCol = 2 'シート名の埋まっているセルたちの列番号
　　Dim RowCounter As Long
　　Dim PageCnt As Long
　　Dim PrinGo As Boolean
　　Dim ShRange As Range
　　Dim ShName As String

　　PageCnt = 0　　　　　'初回判定用カウンター
　　RowCounter = 3　　　 'シート名の埋まっているセルたちの開始行
　　.Select
　　Do
　　　If .Cells(RowCounter, DataCol).Value = "" Then Exit Do
　　　Set ShRange = Range(.Cells(RowCounter, DataCol), _
　　　　　　　　　　　　.Cells(RowCounter, DataCol)) 'シート名セルを特定
　　　ShName = ShRange.Text　　　　　　　　　　　　　'シート名を取得

　　　If IsSelect(ShRange) = True Then　　　　　　　 '選択しているか？

　　　　If IsShFound(ShName) = False Then　　　　　　'シートが存在するか？
　　　　　MsgBox "シートが見つかりません" & "/" & ShName
　　　　　Exit Sub
　　　　End If

　　　　PageCnt = PageCnt + 1
　　　　If PageCnt = 1 Then
　　　　　ThisWorkbook.Sheets(.Cells(RowCounter, DataCol).Value).Select
　　　　　PrinGo = Application.Dialogs(xlDialogPrint).Show
　　　　　If PrinGo = False Then
　　　　　　.Select
　　　　　　Exit Sub
　　　　　End If
　　　　Else
　　　　　ThisWorkbook.Sheets(.Cells(RowCounter, DataCol).Value).PrintOut _
　　　　　　Copies:=1, Collate:=True, IgnorePrintAreas:=False
　　　　End If
　　　End If
　　　.Select
　　　RowCounter = RowCounter + 1
　　Loop

　End With

　If PageCnt = 0 Then
　　MsgBox "シート名の埋まったセルが選択されていません"
　End If

End Sub

Function IsSelect(Rng As Range) As Boolean
　If Application.Intersect(Selection, Rng) Is Nothing Then
　　IsSelect = False
　Else
　　IsSelect = True
　End If
End Function

Function IsShFound(ShName As String) As Boolean
　Dim ws As Worksheet
　For Each ws In Worksheets
　　If ws.Name = ShName Then
　　　IsShFound = True
　　　Exit Function
　　End If
　Next ws
End Function

お礼

おはようございます。
毎回お世話になりっぱなしです。
朝一で期待通りの動きを確認しました。

一発でカ・ン・ペ・キ！！

補足

これまで教わったすべてのVBAコードを仕込んだBookを「ひな形」にして後任者が新規業務の対応もしやすいようにしました。
とにかくHohopapaさんには感謝の雨あられです。

質問に書いた2番目の課題については相当に面倒な事が分りました。

この課題は1番目の発展形として思いついたもので、1番目が完璧に達成できたので2番目は中止します。

当方にはハードルが高そうなこと、お手数をかける割には有難みが小さいこと、Hohopapaさんの時間と知力の無駄。
と言うことで課題２はコスパが悪いので「没」とします。

今後の当方のHELPに備えてご自愛ください。
本当にありがとうございました。