VBAでBingo5_5

2023年12月22日 22:28

今回は、前回(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 Sub

VBAエディターを開いて、最後の行に貼り付けてください。
シート「抽出」に実行ボタン「PDF出力」を作って、関連付けてください。

実行ボタンをクリックするとフォルダ「PDF」の中にPDFファイルが出力されます。

今回も最後までご覧いただき、ありがとうございました。

この記事が気に入ったらサポートをしてみませんか？