ＶＢＡを使ってキー （ex 所属部）が変われば、改ページをした結果を、キーを含むファイル名のPDFとして出力したい

Question

どなたかご教示下さい。（Excel2010を使用中）

　これまで職場では、ある方がネットで公開していたVBAを基に、所属や従業員の氏名などを含む5000件くらいのリストから、職場ごとに改ページを挿入し、印刷すると職場別の帳票ができるようにして、各部に紙ベースで配布してきました。

　ところが、今年の10月から総務部から「印刷は最小限にして、配布はデジタルで」とのお達しが来ました。

そこで10月以降、複合機には出力せずに、Adobeのプリンタを使うことでPDF化したのですが、このPDFファイルを職場ごとにバラバラにして、どこの部署か確認しながら、ファイル名に職場名を含むように手でファイル名を変えて、メールで送信していました。この方法で10〜11月は乗り切ったのですが、さすがにこのやり方では手間がかかりすぎると思い、試行錯誤してみたのですが回答にたどりつけませんでした。

　印刷結果、もしくはExcelシートの範囲を指定して、PDFとして保存できないか試したのですが、わかりませんでした。更に、その出力ファイル名を、例えば「2018年11月　残業時間累計　＊＊＊＊部」というように、出力するPDFのファイル名に、キーとした職場名を含むようにしたいのです。

　お知恵を拝借させてください

　にゃか

Answer 1

> はい、その通りです。

水平改ページの挿入処理に関して誤りがないのであれば、

それぞれの水平改ページが挿入されたセルを

PDF 出力範囲の基点として用いる手法が考えられます。

> 新規のブックかワークシートを生成する、という考え方ですか。

これに関しては、「 pdf だけじゃなくて xlsx でちょーだい！」

というニーズがどこかから生じる可能性が考えられたため、

あくまで一例として挙げたに過ぎません。

例えば次のようなコードであれば、水平改ページが設定された範囲ごとに

PDF ファイルを出力することが出来るはず。

（標準モジュール）

---

Sub ExportPDFbyHPageBreaks()

    '定数の宣言

    Const GroupNameColumn As String = "A"  '[所属]を記録している列

    '変数の宣言

    Dim wbSourceBook As Excel.Workbook

    Dim wsSourceSheet As Excel.Worksheet

    Dim rngPrintRange As Excel.Range

    Dim rngExportRange As Excel.Range

    Dim strFolderPath As String

    Dim strFileName As String

    Dim strGroupName As String

    Dim lngFirstDataRow As Long

    Dim lngLastDataRow As Long

    Dim lngExportStartRow As Long

    Dim lngExportEndRow As Long

    Dim lngExportStartColumn As Long

    Dim lngExportEndColumn As Long

    Dim lngBreak As Long

    Dim strMsg As String

    'アクティブシートを参照

    Set wsSourceSheet = ActiveSheet

    'そのワークブックを参照

    Set wbSourceBook = wsSourceSheet.Parent

    With wbSourceBook

        'ブックが保存されているフォルダのサブフォルダを

        '出力先フォルダとする

        strFolderPath = .Path & "" & Format(Now(), "yyyymmdd")

        '出力先フォルダが存在しない場合

        If Dir(strFolderPath, vbDirectory) = "" Then

            '出力先フォルダの作成

            MkDir strFolderPath

        End If

    End With

    With wsSourceSheet

        'データ行の先頭行の番号の取得

        If .PageSetup.PrintTitleRows = "" Then

            'タイトル行が設定されていない場合は 1 行目とする

            lngFirstDataRow = 1

        Else

            'タイトル行の次の行の番号を取得

            lngFirstDataRow = .Range(.PageSetup.PrintTitleRows).Rows.Count + 1

        End If

        '印刷範囲が定義されていない場合

        If .PageSetup.PrintArea = "" Then

            'A1 セルから、使用中のセル範囲の最終セルまでを

            '仮の印刷範囲とみなして参照

            Set rngPrintRange = .Range(.Cells(1, 1), _

                                       .UsedRange.Cells(.UsedRange.Rows.Count, _

                                                        .UsedRange.Columns.Count))

        Else

            '印刷範囲として定義されているセル範囲を参照

            Set rngPrintRange = .Range(.PageSetup.PrintArea)

        End If

        '印刷範囲から情報を取得

        With rngPrintRange

            '印刷範囲の先頭行がデータ行の先頭行よりも下にある場合

            If lngFirstDataRow < .Row Then

                '印刷範囲の先頭行の番号をデータ行の先頭行の番号として設定

                lngFirstDataRow = .Row

            End If

            '印刷範囲の最終行の番号をデータ行の終了行の番号として設定

            lngLastDataRow = .Rows(.Rows.Count).Row

            '印刷範囲の先頭列をそのまま PDF 出力範囲の開始列とする

            lngExportStartColumn = .Column

            '印刷範囲の最終列をそのまま PDF 出力範囲の終了列とする

            lngExportEndColumn = .Columns(.Columns.Count).Column

        End With

        '水平改ページの挿入数 + 1 回ループ

        For lngBreak = 0 To .HPageBreaks.Count

            'PDF 出力範囲の開始行の行番号の取得

            If lngBreak = 0 Then

                '最初はデータ行（印刷範囲）の先頭行

                lngExportStartRow = lngFirstDataRow

            Else

                '水平改ページが設定されているセルの行番号

                lngExportStartRow = .HPageBreaks(lngBreak).Location.Row

            End If

            'データ行（印刷範囲）の最終行より下の行である場合

            If lngExportStartRow > lngLastDataRow Then

                'ループを抜ける

                Exit For

            End If

            'PDF 出力範囲の終了行の行番号の取得

            If lngBreak < .HPageBreaks.Count Then

                '次の水平改ページが設定されているセルの1つ上の行の番号

                lngExportEndRow = .HPageBreaks(lngBreak + 1).Location.Row - 1

                'データ行（印刷範囲）の最終行より下の行である場合

                If lngExportEndRow > lngLastDataRow Then

                    'データ行（印刷範囲）最終行に補正

                    lngExportEndRow = lngLastDataRow

                End If

            Else

                '最後はデータ行（印刷範囲）の最終行

                lngExportEndRow = lngLastDataRow

            End If

            'PDF 出力範囲の開始行の[所属]の値を取得

            strGroupName = .Cells(lngExportStartRow, _

                                  GroupNameColumn).Value

            '出力先ファイルパスの生成

            strFileName = strFolderPath & "" & _

                          Format(Date, "yyyy年mm月") & _

                          "_残業時間累計_" & _

                          Format(lngBreak + 1, "0000_") & _

                          strGroupName & ".pdf"

            'PDF出力範囲となるセル範囲の参照

            Set rngExportRange = .Range(.Cells(lngExportStartRow, lngExportStartColumn), _

                                        .Cells(lngExportEndRow, lngExportEndColumn))

            'PDF出力

            rngExportRange.ExportAsFixedFormat Type:=xlTypePDF, _

                                               Filename:=strFileName, _

                                               Quality:=xlQualityStandard

            '参照解放

            Set rngExportRange = Nothing

        Next

    End With

    '参照解放

    Set rngPrintRange = Nothing

    Set wsSourceSheet = Nothing

    Set wbSourceBook = Nothing

    'メッセージの表示

    strMsg = "'" & strFolderPath & "'に PDF ファイルを出力しました。" & vbCrLf & _

             "フォルダを開きますか？"

    If MsgBox(strMsg, vbInformation + vbYesNo, "実行完了") = vbYes Then

        '[はい]ボタンがクリックされたら出力先フォルダを開く

        Shell "explorer.exe """ & strFolderPath & """", vbMaximizedFocus

    End If

End Sub

---

Answer 2

sk.exe さま

　ありがとうございました。

会社の環境で実行したところ、ちゃんとPDFのファイル名にも所属が入って感動しました。

これから勉強のため、コードの中身を読み込んでいきたいと思います。

　最大限の☆を点灯させたつもりなのですが、ちゃんと点きましたでしょうか？

　これから少しずつ、自分でも簡単なコードであれば作れるように頑張ります。

　本当にありがとうございました。

にゃか

Answer 3

sk.exe さま

　ご返信ありがとうございます。

 金曜日に早速、使わせていただこうとしたのですが、会合のため断念。

家にはMacしかないので、月曜日にやってみますね！

　ありがとうございました。

にゃか

Answer 4

sk.exe さま

　ご返信ありがとうございます。

当方、プログラミングは超初心者で、簡単なVBAもゼロから作成するのは難しく、記録したものや他の方が作成されたものをアレンジするくらいの技量ですので、ご迷惑をおかけします。

> ・ワークシートの先頭の 1 行目（あるいは数行）が

> シートのタイトル行として設定されている。

> ・ワークシートのデータ行（タイトル行より下の行）が

> [職場]の昇順（または降順）にソートされている。

> ・データ行を先頭から順に走査し、異なる[職場]が現れた

> 　タイミングで HPageBreaks オブジェクトの Add メソッドを

> 　呼び出すループ処理を実行している。

> ということでしょうか。

　はい、その通りです。シートのイメージはこのようになっています。

これを３つのPDFファイルにしたいのです。

　現在使用しているものは、このような感じで、列を変更するときは手で直しています。

（ダイアログで指定する方がスマートなのは承知しているのですが・・・）

　シートの指定もちゃんとしていません。アクティブだけです。

Sub 所属ごと()

    Dim i As Long

    Dim SaveKey As Variant

    '改ページを削除

    ActiveSheet.ResetAllPageBreaks

    '1行目をタイトル行に

    ActiveSheet.PageSetup.PrintTitleRows = "$1:$1"

    i = 2

    SaveKey = Cells(i, 1).Value

    'A列の値が空白になるまでループ

    Do Until Len(Cells(i, 1).Value) = 0

        'キーが変更されるまで

        If SaveKey <> Cells(i, 1).Value Then

            '改ページを挿入

            ActiveSheet.HPageBreaks.Add Before:=Cells(i, 1)

            'キーを更新

            SaveKey = Cells(i, 1).Value

        End If

        i = i + 1

    Loop

    '印刷プレビューを表示

    ActiveSheet.PrintPreview

End Sub

>  その環境なら、基本的には Excel 2010 自体が持つ

> PDF 出力機能を呼び出せば済むはず。

>

　ごもっともです。今まで物理プリンタでプリントアウトしていたので、職場のメンバーが混乱しないよう、

マニュアルではプリンターを選ぶのと同じ操作で、Adobeのプリンタを指定させていました。

本来はVBA内で処理すべきですが、私の技量不足です。

>  例えば VBA のコードによって、任意のブックまたは

>  ワークシートを PDF ファイルとして出力したいのであれば、

> [職場]ごとに新規ブックまたは新規ワークシートを生成して

> ExportAsFixedFormat メソッドを呼び出すループ処理を

> 実行するようになさればよいでしょう。

　ありがとうございます。新規のブックかワークシートを生成する、という考え方ですか。

自分はこのVBAを一生懸命いじっていて、ネット上からPDFファイルに出力するコマンドを見つけて、

なんとかくっつけようとしましたが上手くいかず、「これはあくまでも改ページを入れるもので、

基本的な考え方が違うのではないか」と思い、プロの方に質問しようと思い立ったのです。

（この技能レベルです。すみません）

>

> ループ処理の過程で PDF ファイルの保存先となるパス（文字列）を

> 生成して、ExportAsFixedFormat メソッドを呼び出す際に

> 引数 Filename へそのパスを渡すようにすれば可能。

>

>  現時点ではワークシートのレイアウトの詳細が不明ですので、

>  具体的にどのようなコードを記述するべきかについては

> 回答を差し控えます。

 いろいろ説明不足で申し訳ありませんが、なにとぞよろしくお願い致します。

にゃか

Answer 5

> これまで職場では、ある方がネットで公開していたVBAを基に、

> 所属や従業員の氏名などを含む5000件くらいのリストから、

> 職場ごとに改ページを挿入し、印刷すると職場別の帳票が

> できるようにして、各部に紙ベースで配布してきました。

・ワークシートの先頭の 1 行目（あるいは数行）が

　シートのタイトル行として設定されている。

・ワークシートのデータ行（タイトル行より下の行）が

　[職場]の昇順（または降順）にソートされている。

・データ行を先頭から順に走査し、異なる[職場]が現れた

　タイミングで HPageBreaks オブジェクトの Add メソッドを

　呼び出すループ処理を実行している。

ということでしょうか。

> Excel2010を使用中

> Adobeのプリンタを使うことでPDF化

> 印刷結果、もしくはExcelシートの範囲を指定して、

> PDFとして保存できないか

その環境なら、基本的には Excel 2010 自体が持つ

PDF 出力機能を呼び出せば済むはず。

例えば VBA のコードによって、任意のブックまたは

ワークシートを PDF ファイルとして出力したいのであれば、

[職場]ごとに新規ブックまたは新規ワークシートを生成して

ExportAsFixedFormat メソッドを呼び出すループ処理を

実行するようになさればよいでしょう。

> ファイル名に職場名を含むように手でファイル名を変えて、

> メールで送信していました。

> 更に、その出力ファイル名を、例えば

> 「2018年11月　残業時間累計　＊＊＊＊部」というように、

> 出力するPDFのファイル名に、キーとした職場名を含むように

> したいのです。

ループ処理の過程で PDF ファイルの保存先となるパス（文字列）を

生成して、ExportAsFixedFormat メソッドを呼び出す際に

引数 Filename へそのパスを渡すようにすれば可能。

現時点ではワークシートのレイアウトの詳細が不明ですので、

具体的にどのようなコードを記述するべきかについては

回答を差し控えます。