VBAマクロでExcelをPDFに一括変換|フォルダ再帰探索&xls/xlsx/xlsm対応コード

概要

本記事では、VBAマクロでExcelをPDFに一括変換する方法について解説していきます。

というのも大量のExcelを1個ずつ手作業でPDF化するの、地味に時間がかかるしミスも出ますよね(- -;

特にフォルダが入れ子になっていたり、xls/xlsx/xlsmが混在してたりすると正攻法だと結構しんどい作業です。

ここではフォルダ配下のExcelファイル(.xls/.xlsx/.xlsm)を再帰的に探索し、シート単位で一括PDF化するコードをそのままコピペで使える形で紹介していきます!

F5を押すだけで動く完成形のVBAコードなので、すぐ使えます。
それではやっていきましょう!

目次

事前準備

マクロ実行用のExcelファイルを用意する

まずはマクロを動かすためのExcelファイルを新規作成します。

拡張子はマクロが有効な形式の「.xlsm」で保存してください。

1枚目のシート(Sheet1)のセルに、検索元と出力先のフォルダパスを入力します。

<セルに入力する内容>
  • C1セル
    • 検索元フォルダのパス(必須)
    • 例:C:\work\excel_files
  • C2セル
    • PDF出力先フォルダのパス(任意)
    • 空欄の場合は、各Excelファイルと同じフォルダにPDFが出力されます
C2セルを空欄にしておくと、「Excelと同じ場所にPDFを置きたい」という使い方もできるので便利ですよ!

標準モジュールを追加する

Excelファイルを開いたら「開発」タブ →「Visual Basic」をクリックしてVBE(Visual Basic Editor)を開きます。

VBEを開いたら「挿入」→「標準モジュール」をクリックして、Module1を追加しましょう。

「開発」タブが表示されていない場合は、「ファイル」→「オプション」→「リボンのユーザー設定」から「開発」にチェックを入れて有効化してください。

マクロのコードを貼り付ける

追加したModule1に、下記コードを丸ごと貼り付けます。

コードは役割ごとに3つのSubに分かれています。

<コードの構成>
  • ConvertAllXlsToPdf
    • エントリーポイント(最初に実行するマクロ)
  • SearchAndConvert
    • 指定フォルダを再帰的に検索する処理
  • ConvertFileToPdf
    • 個別ファイルをPDF化する処理

Module1(VBA)

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
Sub ConvertAllXlsToPdf()
Dim folderPath As String
Dim outputFolder As String
Dim useSourceFolder As Boolean

' C1とC2セルからパスを取得
folderPath = ThisWorkbook.Worksheets(1).Range("C1").Value
outputFolder = ThisWorkbook.Worksheets(1).Range("C2").Value

' C1が空の場合はエラー
If folderPath = "" Then
MsgBox "C1セル(検索元フォルダ)にパスを入力してください。", vbExclamation
Exit Sub
End If

' フォルダが存在するか確認
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")

If Not fso.FolderExists(folderPath) Then
MsgBox "C1セルのフォルダが存在しません: " & folderPath, vbExclamation
Exit Sub
End If

' C2が空または存在しない場合は各ファイルと同じフォルダに出力
If outputFolder = "" Then
useSourceFolder = True
MsgBox "出力先フォルダが指定されていないため、各Excelファイルと同じフォルダに出力します。", vbInformation
ElseIf Not fso.FolderExists(outputFolder) Then
MsgBox "C2セルのフォルダが存在しないため、各Excelファイルと同じフォルダに出力します。", vbInformation
useSourceFolder = True
Else
useSourceFolder = False
End If

' 再帰的に検索・変換
Application.ScreenUpdating = False
Application.DisplayAlerts = False

Call SearchAndConvert(folderPath, outputFolder, useSourceFolder)

Application.DisplayAlerts = True
Application.ScreenUpdating = True

MsgBox "変換完了しました!", vbInformation

Set fso = Nothing
End Sub

' 再帰的にフォルダを検索する関数
Sub SearchAndConvert(ByVal folderPath As String, ByVal outputFolder As String, ByVal useSourceFolder As Boolean)
Dim fso As Object
Dim folder As Object
Dim subFolder As Object
Dim file As Object

Set fso = CreateObject("Scripting.FileSystemObject")
Set folder = fso.GetFolder(folderPath)

' 現在のフォルダ内のファイルを処理
For Each file In folder.Files
If LCase(fso.GetExtensionName(file.Path)) = "xls" Or _
LCase(fso.GetExtensionName(file.Path)) = "xlsx" Or _
LCase(fso.GetExtensionName(file.Path)) = "xlsm" Then
Call ConvertFileToPdf(file.Path, outputFolder, useSourceFolder)
End If
Next file

' サブフォルダを再帰的に処理
For Each subFolder In folder.SubFolders
Call SearchAndConvert(subFolder.Path, outputFolder, useSourceFolder)
Next subFolder

Set fso = Nothing
End Sub

' 個別ファイルをPDF化する関数
Sub ConvertFileToPdf(ByVal filePath As String, ByVal outputFolder As String, ByVal useSourceFolder As Boolean)
Dim wb As Workbook
Dim ws As Worksheet
Dim fileName As String
Dim pdfName As String
Dim fso As Object
Dim targetFolder As String

On Error Resume Next

Set fso = CreateObject("Scripting.FileSystemObject")
fileName = fso.GetBaseName(filePath) ' 拡張子なしのファイル名

' 出力先フォルダを決定
If useSourceFolder Then
' Excelファイルと同じフォルダに出力
targetFolder = fso.GetParentFolderName(filePath)
Else
' 指定された出力先フォルダに出力
targetFolder = outputFolder
End If

' ファイルを開く
Set wb = Workbooks.Open(filePath, ReadOnly:=True)

If Not wb Is Nothing Then
' 各シートをPDF化
For Each ws In wb.Worksheets
pdfName = targetFolder & "\" & fileName & "_" & ws.Name & ".pdf"

' 無効な文字を置換
Dim cleanFileName As String
cleanFileName = fileName & "_" & ws.Name
cleanFileName = Replace(cleanFileName, "/", "_")
cleanFileName = Replace(cleanFileName, ":", "_")
cleanFileName = Replace(cleanFileName, "*", "_")
cleanFileName = Replace(cleanFileName, "?", "_")
cleanFileName = Replace(cleanFileName, """", "_")
cleanFileName = Replace(cleanFileName, "<", "_")
cleanFileName = Replace(cleanFileName, ">", "_")
cleanFileName = Replace(cleanFileName, "|", "_")

pdfName = targetFolder & "\" & cleanFileName & ".pdf"

ws.ExportAsFixedFormat Type:=xlTypePDF, _
fileName:=pdfName, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
Next ws

wb.Close SaveChanges:=False
End If

Set wb = Nothing
Set fso = Nothing

On Error GoTo 0
End Sub

コードのポイント解説

コード全体は長いので、押さえておきたいポイントだけ抜粋して解説していきます。

セルから入出力パスを読み取る

パスはマクロ内にハードコーディングせずにC1・C2セルから読み取る設計にしています。

パス取得部分の抜粋

1
2
folderPath = ThisWorkbook.Worksheets(1).Range("C1").Value
outputFolder = ThisWorkbook.Worksheets(1).Range("C2").Value

こうすることで、対象フォルダを変えたくなってもセルの値を書き換えるだけで済みます。
マクロ本体を何度も修正しなくて良いので、運用がとても楽!!

再帰検索で xls / xlsx / xlsm を拾う

SearchAndConvert ではサブフォルダも含めて再帰的に探索しています。

拡張子判定の抜粋

1
2
3
4
5
If LCase(fso.GetExtensionName(file.Path)) = "xls" Or _
LCase(fso.GetExtensionName(file.Path)) = "xlsx" Or _
LCase(fso.GetExtensionName(file.Path)) = "xlsm" Then
Call ConvertFileToPdf(file.Path, outputFolder, useSourceFolder)
End If

旧形式の「.xls」も判定対象に含めているので、Excel 97-2003 形式で保存された古い資料もそのまま変換できます。
古い資料が残っている現場では、よくあるので、痒い所に手が届くようにしてます!

シート単位でPDF化する

ConvertFileToPdf の肝はブック内の各シートを個別のPDFとして出力するところです。

PDF出力部分の抜粋

1
2
3
4
5
6
7
8
9
For Each ws In wb.Worksheets
' ...(中略)...
ws.ExportAsFixedFormat Type:=xlTypePDF, _
fileName:=pdfName, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
Next ws

出力されるPDFのファイル名は「[Excelファイル名]_[シート名].pdf」という命名ルールになります。
1ブックに複数シートがあっても、シートごとにバラしてPDF化できるので整理しやすいです。

ファイル名に使えない文字を置換する

シート名に「/」「:」「*」「?」「”」「<」「>」「|」といった文字が含まれていると、そのままPDFのファイル名にできずに保存エラーになります。

無効文字の置換部分の抜粋

1
2
3
4
5
6
7
8
cleanFileName = Replace(cleanFileName, "/", "_")
cleanFileName = Replace(cleanFileName, ":", "_")
cleanFileName = Replace(cleanFileName, "*", "_")
cleanFileName = Replace(cleanFileName, "?", "_")
cleanFileName = Replace(cleanFileName, """", "_")
cleanFileName = Replace(cleanFileName, "<", "_")
cleanFileName = Replace(cleanFileName, ">", "_")
cleanFileName = Replace(cleanFileName, "|", "_")

あらかじめアンダースコアに置換しておくことで、どんなシート名でも安全にPDF化できるようにしています。

実行方法

準備ができたら、あとは実行するだけです。

<実行手順>
  1. Sheet1 の C1セルに検索元フォルダのパスを入力
  2. 必要ならC2セルに出力先フォルダのパスを入力(空欄でもOK)
  3. VBE を開いて ConvertAllXlsToPdf の中にカーソルを置く
  4. F5キーを押して実行
  5. 「変換完了しました!」のメッセージが出たら完了
出力先フォルダが未指定や存在しない場合は、自動的に各Excelファイルと同じ場所にPDFが出力されます。
フォルダを作成する手間が省けて便利ですね!
マクロを動かすExcelファイル自体は「.xlsm」形式で保存してください。
「.xlsx」のままだとマクロが保存されず、次回開いたときに消えてしまいます。

個人的にはボタンを配置しておいてボタンを押すだけで自動実行できるようにしておくことをお勧めします(^^/

よくあるつまずき

元ファイルが書き換わらないか心配

Workbooks.Open の際に ReadOnly:=True を指定しているので、元のExcelファイルが編集・保存されることはありません。
安心して一括変換できます。

処理がとにかく遅い

大量のファイルを変換するときは、Application.ScreenUpdating = False で画面描画をオフにしているので既に高速化の手は打っています。
それでも遅い場合は、対象フォルダを分割して実行するのがおすすめです。

PDFの余白が広すぎる

IgnorePrintAreas:=FalseExcel側で設定されている印刷範囲をそのまま使う仕様にしています。
印刷範囲が未設定のシートだと余白が広くなることがあるので、元のExcel側で印刷範囲を設定しておくと綺麗に仕上がります。

締め

手作業で1ファイルずつ開いてPDF保存する作業、本当に面倒ですよね。

今回のマクロを使えば、フォルダを指定してF5を押すだけで、配下のExcelが全部PDFになります。
特に旧形式の「.xls」が大量に残っている資料整理の現場では、かなりの工数削減になるはずです!

定時で帰るために効率化はガンガンやっていきましょう!

以上となります。
面倒な手作業はVBAに任せて、コーヒーでも飲んで待ちましょう(^^b
それではお疲れさまでした!