VBAでBingo5_5
今回は、前回(VBAでBingo5_4)の処理を繰り返し運用していく中で、新規のデータを作る前に現行データを保存したくなります。そこで、便利なのが「編集」「編集1」「編集2」…を一括してPDF Fileに出力するものです。そして、処理済みのシートを削除して、次の処理に備えます。
それでは、説明を始めますが、まず準備です。
今回は、処理用のフォルダを作りましょう。
任意の場所、例えばDesktopにFolder「Bingo5」を作成してください。
そして、その中に前回作ったBook「B5.xlsm」を移してください。
さらに、Folder「PDF」を作成してください。
これから、Book「B5.xlsm」のシートをPDF化してフォルダ「PDF」の中に出力します。
それでは、いつものようにPDF化の手順をマクロに記録します。対象とするシートは「編集」だけにします。
Sub Macro1()
'
' Macro1 Macro
'
'
Sheets("編集").Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"C:¥Bingo5¥”B5.pdf", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
True
End Sub
このようなマクロができましたか？
ここでは、PDFファイルを出力するフォルダ名とその場所およびPDFファイル名とPDF化するシートの情報が必要となりそうです。
出力場所については「B5.xlsm(自分自身)」と同じフォルダ内にあるフォルダ「PDF」なので、Thisworkbook.Path を使えば自分の居場所を取得することができます。また、そこと同じフォルダ内にあるフォルダについては、そのまま”&”で連結することで指定できます。ただし、フォルダやファイルについては境目に”￥”（PCによっては"\"）を付ける決まりになっているので注意が必要です。場所を受取る変数をDRとして整理すると
DR= Thisworkbook.Path & "¥PDF" となります。
そして、ファイル名を変数Fnとすると Fn="PDFxxx.pdf" としますが、さらに Fn=Replace(Fn,"xxx",cells(3,"L")) としてxxxを回別の数値に置換えることにします。
もうひとつの「シート」の課題は、PDF化するシート(対象シート)がSelectされていることが必要です。対象シートが１枚であればそのシート名を直接記述してSelectできますが、今回は「複数のシート」を想定しているので、一工夫必要です。
それには「配列(array)」とよばれる特殊な変数を使います。普通の変数は、文字や数値を入れるための「１個の箱」のようなものですが、「配列」はこの箱がいくつか集まった「タンス」のようなものです。そしてそのタンスの引出しを「要素（element）」と呼んでいます。
それから配列を使うには、宣言文としてDim 配列名PPP(要素数e)を記述してe個の引出しを持つPPPというタンスを使います。と定義します。さらに注意すべき点は、要素番号が0から始まる点です。たとえばPPP(4)とすると、配列PPPの中には0～4までの要素(引出し)が存在します。つまり(4)に対して実際は５個の要素が存在することに要注意です。
そして、この要素に対象シート名を1枚ずつを入れて、配列名で一括してSelectすることが可能です。
それでは、要素の数をいくつにすれば良いでしょうか。普通なら余裕をもって多めに、例えば100などとしたいところです。しかし、ここにも壁があります。それは、要素を100とした場合0～100までのすべての要素にシート名が入っていなければ、Selectの処理が止まってしまうのです。ところが、コーディングの時点では、シートが何枚になるのか分かりません。では、不可能ということになりますが、あきらめるのはまだ早いです。この助っ人として、ReDim 配列名PPP(要素数e)があります。これは、処理の途中で要素数を任意に設定できる優れものです。なので、eの値を「対象シート数-1」とすれば良いのです。ここでも要素は0から始まるので、実数から 1 引くことに要注意です。
それから、配列の各要素に「対象シート名」を１枚ずつ入れる際にも注意すべき点があります。
本来なら、シート番号に対応する要素番号に入れたいところですが、今回の処理では「抽出」を除くシートを対象としていることと、配列の要素番号が0から始まるため対応付けが複雑になります。
また、配列PPPの要素数は、最後のシート番号をScとするとPPP(Sc-2)となることに注意です。
最後のシート番号は Sc=Sheets.Count で求められます。
具体的には、2番目のシートから最後のシートまでを要素0から順に入れていくことになるので、
シート番号を i として繰り返しの構文を書くと For i=2 to Sc となります。
整理すると
Sc=Sheets.Count ’最後のシート番号
ReDim PPP(Sc - 2)
For i=2 to Sc
PPP(i-2)=Sheets(i).Name
Next i
とすれば、Sheets(2)がPPP(0)にSheets(3)がPPP(1)に…入れられることになります。
最後の処理は、処理済みのシートを削除することですが、削除する前にMsgboxを表示して「削除の意思」を確認することにします。
「意思を受取る」MsgBoxは、変数RC=MsgBox(" メッセージ文",Bt+Ic,"タイトル文")とすると、メッセージボックスの押されたボタンがRCに数値として代入されます。ここでは「Btに4」を入れて、「はい」と「いいえ」のボタンを表示します。また「Icに32」を入れてクエスチョンマークを表示します。RCの値は「はい」のとき6、「いいえ」のときに7が入るので、RC＝6のときだけ削除の処理を実行して、シート「抽出」をActiveSheetにします。
なお、MsgBoxの詳しい説明については「箸休め3」をご参照ください。
シート削除の処理はSheets(Sn).Deleteで、Snが実際削除するシートの番号となります。また、これだけだと実行する際にExcelさんから、シート削除に関する警告メッセージが表示されるので、これを表示させないために Application.DisplayAlerts = False を入れて、削除した後 Application.DisplayAlerts = True で元の設定に戻します。
実際には「抽出」と「編集」の二つのシートは残したいので、常にSheets(3)を削除するようにして、最後のSheets(Sc)まで繰り返せば完了です。
完成コードサンプル
Sub PDF()
Kb = Sheets("抽出").Cells(3, "L") '回別
Fn = Replace("PDFxxx.pdf", "xxx", Kb) 'PDF_File名
DR = ThisWorkbook.Path & "¥PDF" '出力先フォルダ
Sc = Sheets.Count 'シート枚数
ReDim PPP(Sc - 2) '配列の宣言
For i = 2 To Sc '2枚目～最後のシートまで
PPP(i - 2) = Sheets(i).Name '要素にシート名をPUT
Next i
Sheets(PPP).Select '複数のシートを選択
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=DR & "¥" & Fn, _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=True 'PDF作成構文
RC = MsgBox(" PDF化処理が完了しました。" & Chr(13) & Chr(13) _
& " 処理済のシートを削除しますか？" & Chr(13) _
& " [は い]：削除する" & Chr(13) _
& " [いいえ]：削除しない" & Chr(13) _
, 4 + 32, "Bingo5 nJun") '意思確認メッセージ
If RC = 6 Then '応答ボタン「はい」のとき
Application.DisplayAlerts = False 'シート削除警告メッセージを非表示
For n = 3 To Sc
Sheets(3).Delete 'シート削除
Next n
Application.DisplayAlerts = True '警告メッセージを表示モードに戻す
End If
Sheets("抽出").Select '抽出をActiveSheetにする
End SubVBAエディターを開いて、最後の行に貼り付けてください。
シート「抽出」に実行ボタン「PDF出力」を作って、関連付けてください。
実行ボタンをクリックするとフォルダ「PDF」の中にPDFファイルが出力されます。
今回も最後までご覧いただき、ありがとうございました。