【Excel VBA】Excelのシート毎に分けてPDF出力するツール(コピペですぐ使える)

 

Excelで作成したデータをPDFファイルで保存または出力する際に、シート毎で複数のPDFファイルで保存したいと思った際に、Excelの標準機能では現状実現することができないかと思います。

 

そのため、一つのPDFファイルに保存する場合複数のPDFファイルに分けて保存する場合とで使い分けることができるツール『Excelのシート毎に分けてPDF出力するツール』をExcelマクロ(アドイン)で作成しました。

 

これを使用すれば定例業務の業務効率化が図れるかと思いますので、是非ご活用頂けたらと思います。

 

『Excelのシート毎に分けてPDF出力するツール(アドイン)』の概要

ExcelにVBAコードを入れてマクロを作成し、アドインとして保存します。

 

そのアドインを取り込むとリボンに一つのPDFで保存するパターンと複数のPDFで保存するパターンとでタブが表示されるので、それぞれ該当するボタンを押すことでPDFファイルの出力方法を使い分けることができます

 

当ツールの使用方法

基本的な機能、操作方法の説明

1.PDF出力したいExcelファイルを開きます。

2.「開発」タブの「Excelアドイン」より、作成したアドインファイルを指定(参照)します。

今回作成するアドイン「divide_pdf_export.xlam(※ダウンロードして作成した場合のデフォルト名)」を指定します。

 

<パターン1>

3.リボン「PDFで保存」→「1つのPDFで保存」内にある「全シートを対象」クリックします。

 

4.保存先を選択し、ファイル名を入力して「保存」をクリックします。

※デフォルトのファイル名は「Excelファイル名称」+「.pdf」となっています

全シート分のExcelデータが一つのPDFファイルとして保存されました。

 

<パターン2>

3ー2.リボン「PDFで保存」→「1つのPDFで保存」内にあるシート名を入力して、「指定シートを対象」をクリックします。

 

4ー2.保存先を選択し、ファイル名を入力して「保存」をクリックします。

※デフォルトのファイル名は「Excelファイル名称」+「.pdf」となっています

リボン内の指定シートを対象の「シート名」に入力したシートを対象にしてExcelデータが一つのPDFファイルとして保存されました。

 

<パターン3>

3ー3.リボン「PDFで保存」→「複数ののPDFで保存」内にある「先頭のファイル名称」に値を入力して、「全シートを対象」をクリックします。

 

4ー2.保存先のフォルダを選択して「OK」をクリックします。

※複数PDFファイルが作成されるため、保存先のフォルダを選択します

リボン内で指定した「先頭のファイル名称」+「シート名」をファイル名とした複数のPDFファイルが保存されました。

 

留意事項

シート名はワイルドカードが使用可能

一つのPDFで保存する時に、指定シートを対象にしてPDF出力する場合は、シート名の指定でワイルドカードを指定できます。

例)①:「R4*」→R4から始まるシートが対象  ②:「*10月」→最後に10月がつくシートが対象

 

使用する際の事前準備

このページの下部にある「Excelファイルのサンプル」からExcelファイルを取得し、「準備の手順」内にあるVBAコードを取得したExcelファイルに記載して保存すれば、すぐに当ツールを使用できます。

 

以下にその手順を説明していきます。

 

準備の手順

1.サンプルのダウンロードはこちら」からサンプル(Excelファイル)をダウンロードし、ファイルを開きます。

※インターネットにあるマクロファイルをダウンロードすることはセキュリティ上リスクがあるので、マクロ無しExcelファイルを公開しています

 

2.ダウンロードしたExcelファイルの上部にあるリボンの「開発」タブから「visual basic」を選択して、VBE(Visual Basic Editor)を起動させます。

 

リボンに「開発」タブが表示されていない場合は、以下を参照ください。

 

3.「プロジェクト」に「標準モジュール」を追加して、追加された「Module1」にVBAコードを記載します。

 

以下にあるVBAコードを「Module1」内のエディターにコピーして貼り付けます。

 

※VBAコードの右上のアイコンをクリックするとソースコードをコピーできます

Option Explicit

'-----(メッセージ)-------------------
Private Const Msg1 = "PDfファイルを保存するフォルダを選択してください。"
Private Const Msg2 = "指定したシートが存在しません。"
'---------------------------------------

Dim TgtSheetNm As String
Dim TgtFileNm As String

'===================================
'全シートを対象にして1つのPDFに保存した際の処理
'===================================
Sub allSheetForOnePDF_click(control As IRibbonControl)

    Dim sheetCnt As Long: sheetCnt = ActiveWorkbook.Worksheets.Count
    Dim sheetNmArray() As String
    ReDim sheetNmArray(1 To sheetCnt)
    Dim i As Long
    
    '全てのシートを対象にするため配列に全シート名を格納する
    For i = 1 To sheetCnt
        sheetNmArray(i) = ActiveWorkbook.Sheets(i).Name
    Next i
    
    'PDFファイル保存処理
    Call savePdf(sheetNmArray, 1)
    
End Sub

'===================================
'指定シートを対象にして1つのPDFに保存した際の処理
'===================================
Sub tgtSheetForOnePDF_click(control As IRibbonControl)

    Dim sheetCnt As Long: sheetCnt = ActiveWorkbook.Worksheets.Count
    Dim objSheet As Worksheet
    
    Dim sheetNmArray() As String
    ReDim sheetNmArray(1 To sheetCnt)
    Dim matchCnt As Long
    
    'Excelファイル内で条件に一致するシートのみシート名を配列に格納する
    For Each objSheet In ActiveWorkbook.Worksheets
      
        If objSheet.Name Like TgtSheetNm Then
            matchCnt = matchCnt + 1
            sheetNmArray(matchCnt) = objSheet.Name
        End If
      
    Next
    
    If matchCnt <> 0 Then
        ReDim Preserve sheetNmArray(1 To matchCnt)
    Else
        MsgBox Msg2
        Exit Sub
    End If
    
    'PDFファイルの保存処理
    Call savePdf(sheetNmArray, 1)
    
End Sub

'===================================
'全シートを対象にして複数のPDFに保存した際の処理
'===================================
Sub allSheetForSomePDF_click(control As IRibbonControl)

    Dim sheetCnt As Long: sheetCnt = ActiveWorkbook.Worksheets.Count
    Dim sheetNmArray() As String
    ReDim sheetNmArray(1 To sheetCnt)
    Dim i As Long
    
    '全てのシートを対象にするため配列に全シート名を格納する
    For i = 1 To sheetCnt
        sheetNmArray(i) = ActiveWorkbook.Sheets(i).Name
    Next i
    
    'PDFファイルの保存処理
    Call savePdf(sheetNmArray, 2, TgtFileNm)
    
End Sub

'-------------------------
'PDFファイルの保存処理
' 引数:sheetNmArray(対象のシート名が入った配列)
'       processCd(1:一つのPDFファイルで出力、2:複数PDFファイルで出力)
'    opFileNm(ファイル名の最初に付ける名称)※複数PDFファイルで出力する処理のみ
'-------------------------
Sub savePdf(sheetNmArray() As String, processCd As Long, Optional opFileNm As String = "")
    
    Dim selSheetNm As String
    selSheetNm = ActiveSheet.Name
    
    Dim objFileSys As Object
    Dim noExtensionFileName As String
    Dim fileName As Variant
    Dim sheetNm As Variant
    
    'ファイルシステムを扱うオブジェクトを作成
    Set objFileSys = CreateObject("Scripting.FileSystemObject")
     
    '拡張子無しのファイル名を取得
    noExtensionFileName = objFileSys.GetBaseName(ActiveWorkbook.FullName)
    
    '一つのPDFファイルに保存する場合の処理
    If processCd = 1 Then
    
        'PDFファイルの保存先とファイル名称を指定する
        fileName = Application.GetSaveAsFilename(InitialFileName:=noExtensionFileName, FileFilter:="PDF,*.pdf")
        If fileName <> False Then
            
            Worksheets(sheetNmArray).Select
            ActiveSheet.ExportAsFixedFormat _
            Type:=xlTypePDF, _
            fileName:=fileName
        End If
        
    '複数PDFファイルに保存する場合の処理
    Else

        Dim folderPath As Variant
        
        With Application.FileDialog(msoFileDialogFolderPicker)
            .AllowMultiSelect = False
    
            .Title = Msg1
            If .Show = True Then
                folderPath = .SelectedItems(1)
            Else
                Exit Sub
            End If
        End With
        
        For Each sheetNm In sheetNmArray
            
            If opFileNm <> "" Then
                fileName = folderPath & "\" & opFileNm & "_" & sheetNm & ".pdf"
            Else
                fileName = folderPath & "\" & sheetNm & ".pdf"
            End If
            
            Worksheets(sheetNm).Select
            ActiveSheet.ExportAsFixedFormat _
            Type:=xlTypePDF, _
            fileName:=fileName
        Next
    End If
    
    Worksheets(selSheetNm).Select
        
End Sub

'-------------------------
'シート名に変更があった際の処理
'-------------------------
Sub onChangeSheetNm(control As IRibbonControl, text As String)
    TgtSheetNm = text
End Sub

'-------------------------
'シート名に変更があった際の処理
'-------------------------
Sub onChangeFileNm(control As IRibbonControl, text As String)
    TgtFileNm = text
End Sub

'-------------------------
'シート名を取得する際の処理
'-------------------------
Sub getSheetNm(control As IRibbonControl, ByRef returnValue)
    '処理なし
End Sub

'-------------------------
'ファイル名を取得する際の処理
'-------------------------
Sub getFileNm(control As IRibbonControl, ByRef returnValue)
    '処理なし
End Sub

 

4.ファイルを保存する際は「Excelアドイン(*.xlam)」を選択して、保存します。

 

この作成したアドインを「開発」→「Excelアドイン」→「参照」にてExcelに取り込めば使用できます。

 

これで事前準備は完了です。

あとは「当ツールの使用方法」で記載された方法でツールを実行できます。

 

また、このようなExcelVBAを用いた業務効率化を行うときに、以下の書籍が初心者向けでとても参考になると思いますので、良かったらご参照ください。

 

なお、当マクロの開発環境として、OSは “Windows10” 、Excelのバージョンは “Microsoft Office 365″ で行っており、当環境では動作確認ができていますが、他のすべての環境で正常に動作するかは確認できていません。

 

正常に動作しない場合は、コメントいただければ幸いです。

 

サンプルのダウンロードはこちら

【Excel VBA】Excelのシート毎に分けてPDF出力するツール 

上記よりダウンロードし、記事の途中にありましたVBAコードを組み込んでアドインのツールとして使用してください。

※インターネットにあるマクロファイルをダウンロードすることはセキュリティ上リスクがあるので、マクロ無しExcelファイルを公開しています

 

他に要望等ありましたら、可能な限り改修等を対応しますのでコメント頂ければと思います

 

 

<このツールが『結構使える!』と思ったら、下のグッドボタンを押していただけたら幸いです>

コメントを残す

CAPTCHA