複数の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メソッドを使うことにしました。
この記事へのコメントはありません。