- ベストアンサー
エクセル マクロで印刷
- エクセルのマクロを利用して、複数のシートを一括で印刷する方法を教えてください。
- エクセルBookの目次に複数のシート名を作成し、目次から選択して印刷できるようにする方法を教えてください。
- エクセルBookのSheet 1に他のBookのフルパスを入れ、目次から印刷することができるマクロの作成方法を教えてください。
- みんなの回答 (7)
- 専門家の回答
質問者が選んだベストアンサー
後記コードです。 印刷ダイアログでキャンセルしたら、空振りするようにしました。 実在しないシート名が指定された場合は メッセージを表示して終了するようにしました。 >2番目の課題はご指摘の通り別の質問にします。 >これが出来れば課題1は不要の気がします。 >が、いきなり2番目では(当方にも)難しいかと思い2段階にしたのですが。。。 >1.が出来る人には同じ事、ですかね???? 2ができれば1は不要と思いますが、 1を少し手直しすれば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
その他の回答 (6)
- HohoPapa
- ベストアンサー率65% (455/693)
後記コードでいかがでしょうか。 なお、シート名の埋まったセルを選択していない場合には メッセージを表示するようにしてみましたが セルに埋まったシート名が見つからない場合のエラーは考慮していません。 2つ目の要求については、 どのように動作すればいいのか、 もう一度整理し、スレッドを分けたほうがいいんじゃないかと思います。 特に、 あとから追加要求のあったダイアログの表示や とりわけ、 対象エクセルブックが複数シートだった場合に >複数のBookの複数シート名指定 このシート名の指定をどのようなインターフェースで指定することを考えているかなどです。 Option Explicit Sub Sample1() With ThisWorkbook.Sheets(1) Const DataCol = 2 'シート名の埋まっているセルたちの列番号 Dim RowCounter As Long Dim PageCnt As Long PageCnt = 0 '初回判定用カウンター RowCounter = 3 'シート名の埋まっているセルたちの開始行 .Select Do If .Cells(RowCounter, DataCol).Value = "" Then Exit Do If IsSelect(Range(.Cells(RowCounter, DataCol), _ .Cells(RowCounter, DataCol))) = True Then PageCnt = PageCnt + 1 If PageCnt = 1 Then ThisWorkbook.Sheets(.Cells(RowCounter, DataCol).Value).Select Application.Dialogs(xlDialogPrint).Show 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
お礼
早々のご対応に感謝です。 補足に記載抜けましたが、一度エクセルを閉じれば使えるので、取り敢えずこれでOKです。 修正版はお時間のある時で結構です。(当たり前!ですが) 次の月報は毎月末ですので?? (シッカリ納期?ではありませんので誤解無きように) 2番目の課題はご指摘の通り別の質問にします。 これが出来れば課題1は不要の気がします。 が、いきなり2番目では(当方にも)難しいかと思い2段階にしたのですが。。。 1.が出来る人には同じ事、ですかね???? <予告編> A列にファイルのフルパス、B列の横のセルに「シート名」をイメージしています。 (限定しない方が良いかと思い記載しませんでした)
補足
毎度です。 朝一で確認しました。 目次の「Sheet1」のシート名もシートの場所、入力セルの位置の変更も出来ることを確認しました。シート名を選択しなかった場合(確かに有り得ます)のエラーメッセージを含めこれ以上何を望むことが有ろうか!という感じです。 とまで書いて、ふとよくやる、シートの選択間違いや、選択忘れが有るので再度エクセルに戻って印刷ダイアログでキャンセルをしてみたら、下記の2つのケースが出ました。 よって、お礼から補足に転記しました。 1.最初の1枚目のみ印刷中止されて、2枚目以降印刷されてしまう。 2.何度か試行していたら、一度は印刷がキャンセルされる(ように見える)のですがVBAがエラーで止まっており「継続」をクリックすると印刷が開始されてしまいます。 1.と2.の状況がどう違うのか確認していませんが(既にかなり印刷してしまっているので)先ず症状がご理解いただけますでしょうか? 1.2の状況が不明の場合再度詳細なケース分けして報告しますので宜しくご検討ください。
- imogasi
- ベストアンサー率27% (4737/17069)
補足されているように、私の例は、複数シートのニーズにこたえた例示コードでは、なかったですね。 そもそも,質問者のニーズ(普通にやる操作で、どこで面倒に感じているか)が、質問に 明記されていない。 何かこれらの操作をやっているときに、いやになって、イライラして、 ついこの質問コーナーに、うっぷんを出したというような感じです。 想像するに、 (1)複数シートの選択の点 (2)印刷のセットアップの点 の不便を想像します。 (1)は ・シートの指定(操作)の「グループ化」でやればできます。(補足にも書いておられることです) https://support.microsoft.com/ja-jp/office/%E3%83%AF%E3%83%BC%E3%82%AF%E3%82%B7%E3%83%BC%E3%83%88%E3%82%92%E9%81%B8%E6%8A%9E%E3%81%99%E3%82%8B-096b40c9-0ee7-4980-bac6-cc92aec7b266 「ワークシートを選択する」 ・たくさんシートがあって、選ぶのが面倒だ。ただし シート名の文字列に特徴がある(例 先頭に、「21年売上」が付いている名から選ぶ。 等なら、VBAで候補を絞って列挙して、選ばせる、などできます。 ーー (2)は、 印刷の設定がバラバラで、指定するのが面倒なら、タイプ別に指定するぐらいのことは VBAでできそうです。あるいはよく変わる項目だけ、VBAのコントロール(部品)で指定するように、できます。 ==== (1)の一例を例示。 シート名の先頭2文字が売上のシート名を、リストボックスのアイテムに出し、印刷希望のシート名を クリックするとそのシートを印刷する。 ページ設定の色色な設定は、組み込んでない。 臭いだけ嗅いでください。 ユーザーフォームに、リストボックス1つと、コマンドボタン1つ貼り付けます。 ーーー ユーザーフォームのモジュールに下記を作る。 Option Base 0 Private Sub CommandButton1_Click() k = 0 ' Dim selSht(0 To 20) As String Dim selSht() As String ReDim seiSht(1) With UserForm1.ListBox1 Dim i As Long For i = 0 To ListBox1.ListCount - 1 If ListBox1.Selected(i) Then MsgBox UserForm1.ListBox1.List(i) ReDim Preserve selSht(i) selSht(k) = UserForm1.ListBox1.List(i) k = k + 1 ListBox1.Selected(i) = False End If Next i End With '---印刷 ページ設定は済みとする MsgBox "印刷します" For i = 0 To k - 1 MsgBox selSht(i) Worksheets(selSht(i)).PrintOut 'Arrat不要 'Sheets(selSht).Select 'Selection.PrintOut Next Application.Quit End Sub ーー Private Sub UserForm_Initialize() ListBox1.MultiSelect = fmMultiSelectMulti For Each sh In Worksheets '--- If sh.Name Like "売上*" Then UserForm1.ListBox1.AddItem sh.Name End If Next ActiveSheet.Select End Sub 面倒なものです。上記も、力不足で、不満足な面があるが、とりあえず。
お礼
何度もお手数を煩わせて申し訳ありません。 確かに要求の動機が抜けています。 要求の背景としては、毎月の月報作成という同じ操作をやっているときに、今まで何も思わずにやっていた作業ですが、他人に引き継ぐことを前提にマニュアルをと思ったら出来るだけ簡単に・・・と思った次第です。 何が面倒か改めて言うと「それ位は都度シートを手動で選択して一括印刷すれば」と言われそうですが。。。 また質問が長がくなるので敢えて割愛した次第です。 面倒だと思う作業は、複数の担当者が各シートに入力するので、シートの内容を明示するためにシート名が長くなってしまうので、印刷時にBook内のシート間をあちこち行き来して探す作業を簡単にと思いました。 目的別に印刷するシートを1ページに目次にしておいて一括選択で印刷出来れば抜けやシート間違いがない。 カラーや両面印刷等の詳細が都度設定出来れば完璧。 その他にも理由があるのですがやはり長くなるので止めます。 これでも十分長い。要領悪くてすみません。 一応コードは試行してみましたが、エラーMsgが出ました。 やはり小生にはハードルが高いご回答のようです。 また、既にほぼ要求を満たしたご回答が有りますのでこれ以上のお手数は無用です。 ありがとうございました。
- HohoPapa
- ベストアンサー率65% (455/693)
- HohoPapa
- ベストアンサー率65% (455/693)
>マクロの最後は「印刷ダイアログ」(プリンターの選択と設定)になるようにお願します。 これは、選択したシートたちの印刷が終わり、 その後、マクロが終了する直前に、添付のダイアログを開くということでしょうか? だとすると、どのシートを印刷するためのダイアログにすればいいでしょうか? それとも、選択した個々のシートの印刷指示をマクロが行うのではなく その都度添付のダイアログを開き、印刷指示は利用者が行うということでしょうか? なお、当方、本業がそこそこ忙しいので このサイトを開く時間は限定的です。 のんびり待っていただくか、 識者のタイムリーなコメントに期待してください。
お礼
お忙しいところ本当にすみません。 当然ですが、気長に待っていますので何卒よろしくお願いいたします。
補足
分かりにくくてすみません。 今はマクロを実行すると通常使うプリンターで印刷が始まってしまいますが、印刷を開始する時にプリンターを選択して「OK」で印刷を開始したいだけです。 「通常使うプリンター」はA4専用の白黒プリンターになっているのですが、場合によってはカラーとか裏紙を選択できるプリンターを選択してから「OK」をクリックして印刷を開始したいのです。
- HohoPapa
- ベストアンサー率65% (455/693)
まずは1つ目の印刷機能 1枚目(つまり」先頭)のシートの2列目(B列)の3行目から下方向に 空白セルが無く、シート名が並んでいるという条件、 更に、印刷対象かどうかは、シート名のセルが選択されているかどうかで判定。 (つまり、任意の複数セルを選択可能ということ) という使い方を想定してコードを書いてみました。 よかったらテストしてみてください。 使い勝手がよければ、 1つ目をベースに2つ目の印刷機能を書いてみます。 Sub Sample1() With ThisWorkbook.Sheets(1) Const DataCol = 2 'シート名の埋まっているセルたちの列番号 Dim RowCounter As Long RowCounter = 3 'シート名の埋まっているセルたちの開始行 Do If .Cells(RowCounter, DataCol).Value = "" Then Exit Sub If IsSelect(Range(.Cells(RowCounter, DataCol), _ .Cells(RowCounter, DataCol))) = True Then ThisWorkbook.Sheets(.Cells(RowCounter, DataCol).Value).PrintOut _ Copies:=1, Collate:=True, IgnorePrintAreas:=False End If RowCounter = RowCounter + 1 Loop End With 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
補足
Hohopapa-さん、おはようございます。 早々に実ファイルで試してみました。 いつも通り1発で完璧に期待通り(以上)に動きました。 1つだけ抜けていた要求を追加させてください。 マクロの最後は「印刷ダイアログ」(プリンターの選択と設定)になるようにお願します。 過去のコードから下記を試行してみましたが、これもいつも通り却下されました。 Application.Dialogs(xlDialogPrint).Show 下のコードとバッティング?するようです。 Copies:=1, Collate:=True, IgnorePrintAreas:=False
- imogasi
- ベストアンサー率27% (4737/17069)
1つ目の要望ですが、ある程度VBAの経験があれば、WEB記事を調べて、関連記事を見つければ、コード作成は、簡単です。しかしその域に達するには、人によっても習得や到着に差がありります。 質問者の場合は、本件はお勧めしません。普通のシートのデータの加工をVBAでやる分野(まずここから手を付ける)でなく、本件は、仕組をいじくるような分野だからです。「イベント」や「ユーザーフォーム」などの勉強を済ませておく必要がありますから。 ーー 私が思いついた、シートタブの上で右クリックして、この印刷メニューを選択して、印刷する例を考えてみました。 例示 標準モジュールに Sub addRightClickMenu() '右クリックメニューを追加する。 '2回実行すると2つ同じものがダブるので注意 With Application.CommandBars("ply").Controls.Add() .Caption = "シート印刷" '説明文 .OnAction = "PrintThisSheet" 'マクロの名前 .BeginGroup = True 'グループにまとめる End With End Sub Sub PrintThisSheet() MsgBox "このシートを印刷します" End Sub Sub test02() Application.CommandBars("ply").Controls("シート印刷").Delete End Sub をコピペして実行すると、シートタブで右クリックすると「シートの印刷」 のメニューが出るので、それを選択すると、「このシートを印刷します」の表示が出ます。 シートを増やした場合も、ちゃんと増えたシートのタブの右クリックでも出てきます。 本当に採用するなら、この次の行以下に印刷するための、VBAのコードを入れておきます。 手動で印刷するときに決める、印刷範囲や何部印刷するかとか、用紙を縦に使うか、などVBAコードで指定しておきます。 ==== 上記説明を質問者が読んで、怯まないなら、やったらよいでしょう。 WEB照会してでも、関連記事もまず出てくると考えてよいでしょう。 でもコピペして実行できた、というのではなく、仕組などをある程度分かったうえでやるべきです。 ーーー 第2の課題(ブックとシートの両方選択)も取り立てて、難しい仕組みを学ぶ必要はないですが、こちらは何通りもの仕組みが考えられるので、そういう面で回答は、難しい。 コントロールと言う部品の中に、選択に関するものが複数あります。 ファイルを選択させる仕組みは、特別のものもあります。
お礼
早々のご回答ありがとうございます。 >上記説明を質問者が読んで、怯まないなら・・・ ご明察!の通り怯みました。。。。 シートタブの右クリックなら、シートの複数選択とあまり変わらない気もするのですが????
お礼
おはようございます。 毎回お世話になりっぱなしです。 朝一で期待通りの動きを確認しました。 一発でカ・ン・ペ・キ!!
補足
これまで教わったすべてのVBAコードを仕込んだBookを「ひな形」にして後任者が新規業務の対応もしやすいようにしました。 とにかくHohopapaさんには感謝の雨あられです。 質問に書いた2番目の課題については相当に面倒な事が分りました。 この課題は1番目の発展形として思いついたもので、1番目が完璧に達成できたので2番目は中止します。 当方にはハードルが高そうなこと、お手数をかける割には有難みが小さいこと、Hohopapaさんの時間と知力の無駄。 と言うことで課題2はコスパが悪いので「没」とします。 今後の当方のHELPに備えてご自愛ください。 本当にありがとうございました。