Excelマクロ

【マクロ配布】シート毎PDF変換について解説

どうぞお越しいただきありがとうございます。”ビジネス代行の梅澤”です。
社内DXは進んでいますでしょうか。
中小企業ですと、なかなか取り組むのが難しいかと思います。

こんな技術があれば、仕事がもっと楽になるのに…

【マクロ配布】Excelファイルの特定キーワードを含むシートをまとめてPDF変換について解説 ビジネス代行の梅澤です。以前に公開しました”シート毎PDF変換”のVBAをキーワードに、弊社のページにいらっしゃる方がかなりの数いまし...
vba_import
  1. 当サイトで配布したコードについては、自己責任でご使用ください。
  2. 配布したコードを利用し発生した不利益については、弊社では一切の責任を負いません。

1.配布コード

今回配布するコードは、

”指定されたフォルダ内のExcelファイルをシート毎にPDF化”

のVBAです。

Sub EXCELファイルPDF化_シート毎() 'フォルダのEXCELファイルの一括変換
        
    Dim Button, T, i, L As Integer
    Dim OpenExcelFileName, ExcelFileName, ExcelFilePath, ExFileName As String
    
    '確認メッセージを無効化します。
    Application.DisplayAlerts = False
    
    
    Button = MsgBox("EXCELファイルの一括PDF変換を行いますか?", vbYesNo + vbQuestion, "確認")
    If Button = vbYes Then
            
            OpenExcelFileName = Application.GetOpenFilename("Microsoft Excelブック,*.xls?")  'ダイアログを表示取り込むフォルダーにあるファイルを選択します。
            
            If OpenExcelFileName <> "False" Then
                ExcelFileName = Dir(OpenExcelFileName)  '指定したファイルパスからファイル名を代入します。
                ExcelFilePath = Replace(OpenExcelFileName, ExcelFileName, "")  '指定したファイルパスを指定します。(ファイルパスからファイル名を取り除く)
               
                MsgBox ExcelFilePath & "この選択フォルダからPDFに変換します。"
            Else
                MsgBox "キャンセルされました"
                Exit Sub  'キャンセルでプログラムを終了します。
                
            End If
        
            ExFileName = Dir(ExcelFilePath & "*.xls?")  '指定したフォルダーから一件目のEXCELファイルを指定します。
 
            
            Do While ExFileName <> ""    '読み込むファイルがなくなるまで繰り返す。
                
                
                Workbooks.Open FileName:=ExcelFilePath & ExFileName, ReadOnly:=True, UpdateLinks:=0  'EXCELファイルを読み取り専用で読み込む
            Call ワークシートごとにPDFに変換
            
            ActiveWindow.Close  '読み込んだファイルを閉じます。
            
            ExFileName = Dir() '次のファイルを指定する。
 
            Loop
           
    Else
        MsgBox "処理を中断します"
    End If   
    MsgBox "PDFファイルに一括変換しました。"   
    Application.DisplayAlerts = True  '確認メッセージを有効化します。
    
End Sub

Sub ワークシートごとにPDFに変換()

Dim i As Long
Dim sh As Worksheet
Dim N As Long
Dim Str As String
Dim suu As Long
Dim sha  As Long

'高速化コード
 Application.ScreenUpdating = False
 
    '全シートをループ
    For Each sh In Sheets
    
       '選択したシートが非表示の時、削除
       If sh.Visible = xlSheetHidden Then
           sh.Delete
       Else
       '上記以外の時、カウント
           N = N + 1
       End If
       
    Next sh
 
    'シート数が1より大きい時
    If N > 1 Then
        'シート1のみ選択
        Worksheets(1).Select Replace:=True
        'シート2も選択
        Worksheets(2).Select Replace:=False
        'シート1のみ選択
        Worksheets(1).Select Replace:=True
        'シート1のみ選択(デフォルト)
        Worksheets(2).Select
        
    End If

    For i = 1 To Worksheets.Count
        'シート名で条件分岐
            If Sheets(i).Visible Then
            
            If WorksheetFunction.CountA(Sheets(i).UsedRange) = 0 And Sheets(i).Shapes.Count = 0 Then
            Else
            
    Str = Right("0000" & i, 3)
    Worksheets(i).ExportAsFixedFormat Type:=xlTypePDF, _
    FileName:=Left(ActiveWorkbook.Name, InStr(ActiveWorkbook.Name, ".xl") - 1) & "_" & Str & "_" & _
    Worksheets(i).Name, _
    Quality:=xlQualityStandard, _
    IncludeDocProperties:=True, _
    IgnorePrintAreas:=False, openafterpublish:=False
    
    End If
    
    End If
    
    Next i
Application.ScreenUpdating = True '高速化コード

End Sub



​

2.プログラム全体の流れ

全体の流れ
  • ダイアログボックスを開いて、実行フォルダを指定。
  • フォルダ内のExcelファイルを開く。
  • 現在開いているシートを一番左のシートから、順番にPDFを作成。
  • 作成PDFには、”元ファイル名”+”連番”+”シート名”のファイル名を付ける

今回作成しましたコードは、2つのプロシージャを作成し、1つは呼び出し用として作成しています。

≪EXCELファイルPDF化_シート毎≫の “Call ワークシート毎にPDF”の部分で呼び出して実行をしています。

下の画像がフロー図です。

≪Excelファイルをシート毎にPDF化する≫
ただそれだけの目的ですが、その中身は様々な要素が絡み合ってプログラムが組まれています。

3.プログラムの解説

1.配布コードのプログラムを分解して解説していきます。
前編
Sub EXCELファイルPDF化_シート毎() 'フォルダのEXCELファイルの一括変換
        
    Dim Button, T, i, L As Integer
    Dim OpenExcelFileName, ExcelFileName, ExcelFilePath, ExFileName As String
    
    '確認メッセージを無効化します。
    Application.DisplayAlerts = False
    
    
    Button = MsgBox("EXCELファイルの一括PDF変換を行いますか?", vbYesNo + vbQuestion, "確認")

Sub ○○()は、プロシージャー名
Dim ○○は変数名
変数名の後にある “Integer”や”string”は変数の型の名前です。

この辺りは、基本的な部分ですので、ここでは深堀せずに進めます。

Application.DisplayAlerts = False
シート操作での変更点などがあった場合に、ファイルを閉じる際に

”ファイルを保存しますか?”

メッセージボックスの表示をキャンセルするコードです。

ファイルは読み取り専用で開きますが、それでも変更があった場合は、前述のようなメッセージボックスが表示されます。

都度表示されるのは、作業効率が悪いので、オフにしています。


“Button”変数は0,1判定用です。
yesをクリック時は”0”が、noをクリック時は”-1”が返されます。

BD_梅澤

true/false の型はboolean型ですが、Inetegerでも問題なく動作します。


“Msgbox ○○”も基本的なコードで、メッセジーボックスの表示です。
後半のvbyesno+vbQuestionは メッセージボックスコードのオプション機能で、
”はい いいえ”のボタンと下記画像のように、”?”のアイコンが表示されます。


中編
 If Button = vbYes Then
            
            OpenExcelFileName = Application.GetOpenFilename("Microsoft Excelブック,*.xls?")  'ダイアログを表示取り込むフォルダーにあるファイルを選択します。
            
            If OpenExcelFileName <> "False" Then
                ExcelFileName = Dir(OpenExcelFileName)  '指定したファイルパスからファイル名を代入します。
                ExcelFilePath = Replace(OpenExcelFileName, ExcelFileName, "")  '指定したファイルパスを指定します。(ファイルパスからファイル名を取り除く)
               
                MsgBox ExcelFilePath & "この選択フォルダからPDFに変換します。"
            Else
                MsgBox "キャンセルされました"
                Exit Sub  'キャンセルでプログラムを終了します。
                
            End If
        
            ExFileName = Dir(ExcelFilePath & "*.xls?")  '指定したフォルダーから一件目のEXCELファイルを指定します。
 
            
            Do While ExFileName <> ""    '読み込むファイルがなくなるまで繰り返す。
                
                
                Workbooks.Open FileName:=ExcelFilePath & ExFileName, ReadOnly:=True, UpdateLinks:=0  'EXCELファイルを読み取り専用で読み込む
            Call ワークシートごとにPDFに変換
            
            ActiveWindow.Close  '読み込んだファイルを閉じます。
            
            ExFileName = Dir() '次のファイルを指定する。
 
            Loop
            
           
    Else
        MsgBox "処理を中断します"
        Exit Sub
    End If
    


If Button = vbYes Then

”YES”をクリック時にダイアログボックスを開き,一括変換したいフォルダ内のファイルを選択します。(どのファイルを選択しても問題ありません)

更に開いたファイルのパス(保存されている場所)を
変数”OpenExcelFileName”に代入します。

If OpenExcelFileName <> "False" Then

ExcelFileName = Dir(OpenExcelFileName) '指定したファイルパスからファイル名を代入します。
ExcelFilePath = Replace(OpenExcelFileName, ExcelFileName, "") '指定したファイルパスを指定します。(ファイルパスからファイル名を取り除く)


OpenExcelFileName(ファイルパスが)空ではない場合に実行。
変数ExcelFileNameにファイル名を代入。(ファイルパスではない)
変数ExcelFilePathに選択したフォルダのパスを代入。

BD_梅澤

この部分のコードは、PDF変換の実行前に表示されるメッセージウィンドウの為の実行ファルダ変数です。削除はできませんが、不要であれば変数の宣言は、

 ExFileName = Dir(ExcelFilePath & "*.xls?")  '指定したフォルダーから一件目のEXCELファイルを指定します。
 
            
            Do While ExFileName <> ""    '読み込むファイルがなくなるまで繰り返す。
                
                
                Workbooks.Open FileName:=ExcelFilePath & ExFileName, ReadOnly:=True, UpdateLinks:=0  'EXCELファイルを読み取り専用で読み込む

変数ExFileNameに変数ExcelFilePath内の.xls、xlsx、xlsmファイルを代入。

あとはコメントに書いてある通りの処理が実行されます。

Call ワークシートごとにPDFに変換
            
            ActiveWindow.Close  '読み込んだファイルを閉じます。
            
            ExFileName = Dir() '次のファイルを指定する。
 

Call ワークシートごとにPDFに変換で
プロシージャ”ワークシートごとにPDFに変換”を呼び出し、実行します。

BD_梅澤

ここがこのVBAのポイントです。”Call プロシージャ”以外は、流用可能です。私自身、複数のVBAを流用し作成してきました。

Sub ワークシートごとにPDFに変換()

Dim i As Long
Dim sh As Worksheet
Dim N As Long
Dim Str As String
Dim suu As Long
Dim sha  As Long

'高速化コード
 Application.ScreenUpdating = False
 
    '全シートをループ
    For Each sh In Sheets
    
       '選択したシートが非表示の時、削除
       If sh.Visible = xlSheetHidden Then
           sh.Delete
       Else
       '上記以外の時、カウント
           N = N + 1
       End If
       
    Next sh
 
    'シート数が1より大きい時
    If N > 1 Then
        'シート1のみ選択
        Worksheets(1).Select Replace:=True
        'シート2も選択
        Worksheets(2).Select Replace:=False
        'シート1のみ選択
        Worksheets(1).Select Replace:=True
        'シート2のみ選択(デフォルト)
        Worksheets(2).Select
        
    End If

    For i = 1 To Worksheets.Count
        'シートが表示されているとき(非表示ではないとき)
            If Sheets(i).Visible Then
            
            If WorksheetFunction.CountA(Sheets(i).UsedRange) = 0 And Sheets(i).Shapes.Count = 0 Then
            Else
            
    Str = Right("0000" & i, 3)
    Worksheets(i).ExportAsFixedFormat Type:=xlTypePDF, _
    FileName:=Left(ActiveWorkbook.Name, InStr(ActiveWorkbook.Name, ".xl") - 1) & "_" & Str & "_" & _
    Worksheets(i).Name & "_" & i, _
    Quality:=xlQualityStandard, _
    IncludeDocProperties:=True, _
    IgnorePrintAreas:=False, openafterpublish:=False
    
    End If
    
    End If
    
    Next i
Application.ScreenUpdating = True '高速化コード

End Sub

このコードは開いているExcelファイルを左のシートから順番にPDF化するコードです。
前半、中半部分のコードはExcelファイルを開くコードです。

主にコメント部分にコードの説明は記載していますので、わかりにくそうな部分だけ解説します。

'上記以外の時、カウント
           N = N + 1

カウントアップ用です。非表示ではないシート(表示されているシート)がどのくらいあるのかを調べています。シート枚数が1枚の場合は、次のコードは必要ない(実行時にエラーが発生する)ので

 'シート数が1より大きい時
    If N > 1 Then
    'シート1のみ選択
        Worksheets(1).Select Replace:=True
        'シート2も選択
        Worksheets(2).Select Replace:=False
        'シート1のみ選択
        Worksheets(1).Select Replace:=True
        'シート2のみ選択(デフォルト)
        Worksheets(2).Select
        
    End If

条件分岐でシート枚数が1より大きい時のみ実行します。このシートの選択は、実行ファイルがシートを複数選択した状態で保存されていた場合、複数シート選択を解除するコードです。

BD_梅澤

このコードを入れないと、複数シート選択がされているExcelファイルはPDF生成時に選択されたシートがそのままPDF化してしまいます。

If WorksheetFunction.CountA(Sheets(i).UsedRange) = 0 And Sheets(i).Shapes.Count = 0 Then
Else

このコードは、空白シートのチェックコードです。意図せずとして、空白のシートが作成されている場合があるかと思います。(取引先から送っていただいたデータなど)

このコードがない場合は空白のPDFが出来上がってしまうか、エラーが発生してVBAが停止してしまうので、それを回避するコードです。
シートに入力されているものがなく、かつ図形や画像などが貼られていないかをチェックしています。

4.まとめ

まとめ
  1. 配布コードの利用は自己責任でお願いします。
  2. Callを活用し、モジュールを分割化。コピペを減らす。
  3. 生成されるPDFはファイル左から順番に、連番を付与しながら生成

小ロットの印刷業務では、まだまだデジタル化できていない分野もあります。
人力での作業はヒューマンエラー発生、長時間労働の原因とも言えます。

VBAの歴史は古く、様々なコードがインターネット上に配布されています。

現在はOFFICE365に新しく”Office Script”も導入されました。
共同編集用のファイルでも実行可能で便利ではありますが、
実行速度の面でも、まだまだVBAの活用の余地はあります。

【コラム】VBAを公開する目的について どうぞお越しいただきありがとうございます。”ビジネス代行の梅澤”です。 今回はVBAをなぜ公開するのか。黙って使っていれば、いい...

ABOUT ME
ビジネス代行 梅澤
入社後に長時間労働に悩んでいたところ、印刷ワークフローシステムに出会う。 ここで初めてDXを実感する。 VBAを学習し、更なる業務効率改善に取り込んでいる。
お問い合わせ

些細なことでも構いません。お困りごと・ご相談など、お気軽にご連絡下さい。
どんなご質問でもお答えいたします。お問い合わせお待ちしております。

まずはお気軽にご連絡ください。
✉ お問い合わせはコチラ