【Excel・VBA】ファイルを一括でPDF化する方法（サンプルコードあり）

1Sub Convert_to_PDF()
2    Dim strDirPath As String
3    strDirPath = Search_Directory() 'フォルダの選択
4    If Len(strDirPath) = 0 Then Exit Sub
5    Call Make_Dir(strDirPath, "\PDF") 'フォルダ作成
6    Call Search_Files(strDirPath)
7    MsgBox ("pdfファイル作成が完了しました")
8End Sub
9
10Private Function Search_Directory() As String 'フォルダの選択
11    With Application.FileDialog(msoFileDialogFolderPicker)
12        If .Show = True Then Search_Directory = .SelectedItems(1)
13    End With
14End Function
15
16Private Sub Make_Dir(ByVal Path As String, ByVal Folder_name As String)
17    If Dir(Path & Folder_name, vbDirectory) = "" Then 'フォルダの存在確認
18        MkDir Path & Folder_name 'フォルダ作成
19    End If
20End Sub
21
22Private Sub Search_Files(ByVal Path As String)
23    Dim strFile As String, strET As String
24    strFile = Dir(Path & "\" & "*.*") 'ファイルの存在確認
25    Application.ScreenUpdating = False
26    Do Until strFile = ""
27        If ThisWorkbook.FullName <> Path & "\" & strFile Then
28            Call Conv_PDF(Path, "\" & strFile)
29        End If
30        strFile = Dir() '次のファイル確認
31    Loop
32    Application.ScreenUpdating = True
33End Sub
34
35Private Function Get_Extension(ByVal Path As String) As String '拡張子を取得
36    Dim i As Long
37    i = InStrRev(Path, ".", -1, vbTextCompare)
38    If i = 0 Then Exit Function
39    Get_Extension = Mid$(Path, i + 1)
40End Function
41
42Private Sub Conv_PDF(ByVal Path As String, ByVal Fn As String)
43    Dim filePath As String, objOffice As Object
44    filePath = Path & "\PDF" & Left$(Fn, InStrRev(Fn, ".")) & "pdf"
45    Path = Path & Fn
46    Select Case Get_Extension(Fn) 'ファイル名から拡張子を取得
47        Case "xls", "xlsx" 
48            Set objOffice = Excel.Application
49            With objOffice.Workbooks.Open(Path)
50                .ExportAsFixedFormat Type:=xlTypePDF, _
51                Filename:=filePath, Openafterpublish:=False
52                .Close
53            End With
54        Case "doc", "docx" 
55            Set objOffice = CreateObject("Word.Application")
56            With objOffice.Documents.Open(Path)
57                .ExportAsFixedFormat OutputFileName:=filePath, _
58                ExportFormat:=17
59                .Close
60            End With
61            objOffice.Quit
62        Case "ppt", "pptx"
63            Set objOffice = CreateObject("Powerpoint.Application")
64            With objOffice.Presentations.Open(Path)
65                .SaveAs Filename:=filePath, FileFormat:=32
66                .Close
67            End With
68            objOffice.Quit
69    End Select
70End Sub
71

1Private Sub Conv_PDF(ByVal Path As String, ByVal Fn As String)
2    Dim filePath As String, objOffice As Object
3    filePath = Path & "\PDF" & Left$(Fn, InStrRev(Fn, ".")) & "pdf"
4    Path = Path & Fn
5    Select Case Get_Extension(Fn) 'ファイル名から拡張子を取得
6        Case "xls", "xlsx" 
7            Set objOffice = Excel.Application
8            With objOffice.Workbooks.Open(Path)
9                .ExportAsFixedFormat Type:=xlTypePDF, _
10                Filename:=filePath, Openafterpublish:=False
11                .Close
12            End With
13        Case "doc", "docx" 
14            Set objOffice = CreateObject("Word.Application")
15            With objOffice.Documents.Open(Path)
16                .ExportAsFixedFormat OutputFileName:=filePath, _
17                ExportFormat:=17
18                .Close
19            End With
20            objOffice.Quit
21        Case "ppt", "pptx"
22            Set objOffice = CreateObject("Powerpoint.Application")
23            With objOffice.Presentations.Open(Path)
24                .SaveAs Filename:=filePath, FileFormat:=32
25                .Close
26            End With
27            objOffice.Quit
28    End Select
29End Sub