複数のExcelファイルをPDFに一括変換する必要があったので、簡単なスクリプトを書いてみました。
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 | 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メソッドを使うことにしました。
この記事へのコメントはありません。