複数のExcelファイルをPDFに一括変換する必要があったので、簡単なスクリプトを書いてみました。
Option Explicit
Dim fp
Dim fso
Dim args
Dim i
Const msoFalse = 0
Const msoTrue = -1
Const xlTypePDF = 0
Const xlQualityStandard = 0
Const wdExportFormatPDF = 17
Const wdExportOptimizeForPrint = 0
Const wdExportAllDocument = 0
Const wdExportDocumentContent = 0
Const wdExportCreateWordBookmarks = 2
Const wdDoNotSaveChanges = 0
Const ppSaveAsPDF = 32
Set fso = CreateObject("Scripting.FileSystemObject")
Set args = WScript.Arguments
If args.Count < 1 Then
MsgBox "当スクリプトにファイルをドラッグ&ドロップして処理を実行してください。", vbExclamation + vbSystemModal
WScript.Quit
End If
For i = 0 To args.Count - 1
fp = fso.GetParentFolderName(args(i)) & ChrW(92) & fso.GetBaseName(args(i)) & ".pdf"
Select Case LCase(fso.GetExtensionName(args(i)))
Case "doc", "docx", "dotm" 'Wordファイル処理
With CreateObject("Word.Application")
.Visible = True
With .Documents.Open(args(i))
.ExportAsFixedFormat fp, wdExportFormatPDF, False, wdExportOptimizeForPrint, wdExportAllDocument, , , _
wdExportDocumentContent, False, False, wdExportCreateWordBookmarks, True, True, False
.Close wdDoNotSaveChanges
End With
.Quit
End With
Case "xls", "xlsx", "xlsm" 'Excelファイル処理
With CreateObject("Excel.Application")
.Visible = True
With .Workbooks.Open(args(i))
.ExportAsFixedFormat xlTypePDF, fp, xlQualityStandard, False, False, , , False
.Close False
End With
.Quit
End With
Case "ppt", "pptx", "pptm" 'PowerPointファイル処理
With CreateObject("PowerPoint.Application")
.Visible = True
With .Presentations.Open(args(i))
.SaveAs fp, ppSaveAsPDF, msoTrue 'ExportAsFixedFormatはエラーになったためSaveAs使用
.Close
End With
.Quit
End With
End Select
Next
MsgBox "処理が終了しました。", vbInformation + vbSystemModal
ついでにWordやPowerPointにも対応させたのですが、PowerPointの場合は、ExportAsFixedFormatメソッドを使おうとすると「型が一致しません」エラーが発生したため、SaveAsメソッドを使うことにしました。




















この記事へのコメントはありません。