どうぞお越しいただきありがとうございます。”ビジネス代行の梅澤”です。
社内DXは進んでいますでしょうか。
中小企業ですと、なかなか取り組むのが難しいかと思います。
『こんな技術があれば、仕事がもっと楽になるのに…』
そんなお悩みがある方も少なくないのではないでしょうか。
弊社では少しでもお悩みを解決できないかと思い、開発したVBAの一部を公開いたします。
当サイトで配布したコードについては、自己責任でご使用ください。

- 当サイトで配布したコードについては、自己責任でご使用ください。
- 配布したコードを利用し発生した不利益については、弊社では一切の責任を負いません。
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”が返されます。
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に選択したフォルダのパスを代入。
この部分のコードは、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に変換”を呼び出し、実行します。
ここがこの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より大きい時のみ実行します。このシートの選択は、実行ファイルがシートを複数選択した状態で保存されていた場合、複数シート選択を解除するコードです。
このコードを入れないと、複数シート選択がされているExcelファイルはPDF生成時に選択されたシートがそのままPDF化してしまいます。
If WorksheetFunction.CountA(Sheets(i).UsedRange) = 0 And Sheets(i).Shapes.Count = 0 Then
Else
このコードは、空白シートのチェックコードです。意図せずとして、空白のシートが作成されている場合があるかと思います。(取引先から送っていただいたデータなど)
このコードがない場合は空白のPDFが出来上がってしまうか、エラーが発生してVBAが停止してしまうので、それを回避するコードです。
シートに入力されているものがなく、かつ図形や画像などが貼られていないかをチェックしています。
4.まとめ
- 配布コードの利用は自己責任でお願いします。
- Callを活用し、モジュールを分割化。コピペを減らす。
- 生成されるPDFはファイル左から順番に、連番を付与しながら生成
小ロットの印刷業務では、まだまだデジタル化できていない分野もあります。
人力での作業はヒューマンエラー発生、長時間労働の原因とも言えます。
VBAの歴史は古く、様々なコードがインターネット上に配布されています。
現在はOFFICE365に新しく”Office Script”も導入されました。
共同編集用のファイルでも実行可能で便利ではありますが、
実行速度の面でも、まだまだVBAの活用の余地はあります。

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