#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
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
