ExcelファイルをPDFファイルに自動変換するVBA

 #Excelファイル　を　#pdfに自動変換　する　#VBAをつくれないだろうかな、と思って作成。簡易的なものなのでエラーテストを十分していないのでご利用は自己責任です。

できてうれしいので公開ときます。ネット上のvba職人さん方々に敬意を表して。

Sub pdf作成()
Dim myPath As String
Dim FileInt As Long
Dim SetPath As String
Dim myFilename As String

Application.DisplayAlerts = False '
myPath = ThisWorkbook.Path
FileInt = 0
SetPath = Dir(myPath & "\" & "*.xls")
Do While SetPath <> ""
FileInt = FileInt + 1

Workbooks.Open Filename:=ThisWorkbook.Path & "\" & SetPath
myFilename = Left(SetPath, Len(SetPath) - 4)

ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, Filename:=ThisWorkbook.Path & "\" & myFilename, OpenAfterPublish:=False
ActiveWorkbook.Close

SetPath = Dir()
Loop
Application.DisplayAlerts = True

End Sub

最終稿：

Sub pdf作成() Dim myPath As String Dim FileInt As Long Dim SetPath As String Dim myFilename As String Dim OriginalPath, OriginalPathName As String On Error Resume Next Application.DisplayAlerts = False myPath = ThisWorkbook.Path FileInt = 0 SetPath = Dir(myPath & "\" & "*.xls") OriginalPath = ThisWorkbook.Name OriginalPathName = Left(OriginalPath, Len(OriginalPath) - 4) Do While SetPath <> "" FileInt = FileInt + 1 Workbooks.Open Filename:=ThisWorkbook.Path & "\" & SetPath myFilename = Left(SetPath, Len(SetPath) - 4) If myFilename = OriginalPathName Then Exit Sub Else End If Debug.Print OriginalPathName ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, Filename:=ThisWorkbook.Path & "\" & myFilename, OpenAfterPublish:=False ActiveWorkbook.Close SetPath = Dir() Loop Application.DisplayAlerts = True End Sub

後日談：Do while文つかっているのだから、IF分を中に噛ませないでDowhileの条件で

　　　　大丈夫じゃないか？とおもったのですが、実際やってみるとうまくいかないんです。

　　　　こういうお手盛りなところが基本設計がよろしくないというところで

　　　　しかしいまのところこの程度のことしかできない...　ご笑納ください

Git-Hub

https://github.com/sjgiken/Excel-PDF-VBA