修改将 .pptx/.docx/.xlsx 保存为 .pdf 的 VB 脚本,以便将 .pptx/.docx/.xlsx 打印为 .pdf

修改将 .pptx/.docx/.xlsx 保存为 .pdf 的 VB 脚本,以便将 .pptx/.docx/.xlsx 打印为 .pdf

我每天都会将一些 .pptx 和 .docx 文件打印成 .pdf 文件。我在网上搜索,找到了链接的脚本这里。我也将把脚本粘贴在下面。

脚本有效伟大的生成 .pdf 文件。但是,我也需要“inking”来打印到 .pdf 文件。据我所知,该脚本删除了“inking”,因为它使用的是.SaveAs方法而不是.PrintOut方法。

.pptx 文件是最紧迫的,所以我首先尝试修复它们。我更改了此行

objSlideDeck.SaveAs PathOfPDF(p_strFilePath), POWERPOINT_PDF, True

到此行

objSlideDeck.PrintOut PrintToFile:="TestPrnt"

但我收到以下错误。

错误信息

.PrintOut我该如何解决这个问题?有没有关于如何使用.pdf 打印的良好参考?我有 Acrobat 许可证,可以从File菜单打印。

这是 VB 脚本。

'http://www.thoughtasylum.com/blog/2012/12/20/vbscript-to-convert-microsoft-office-files-word-excel-powerp.html

Option Explicit

'---------------------
' CONFIGURATION START
'---------------------
'Display a summary in a message box when the conversions are complete
Const SUMMARY_DISPLAY = TRUE
Const SUMMARY_TITLE = "Conversion Complete"

'File extensions for PDFs
Const PDF_Extension = "pdf"

'Results for CheckFile Function
Const CHECKFILE_OK = 0
Const CHECKFILE_FileDoesNotExist = 1
Const CHECKFILE_NotMSOFile = 2

'Settings to produce PDFs from the applications
Const EXCEL_PDF = 0
Const EXCEL_QualityStandard = 0
Const WORD_PDF = 17
Const POWERPOINT_PDF = 32

'File types returned from OfficeFileType function
Const FILE_TYPE_NotOffice = 0
Const FILE_TYPE_Word = 1
Const FILE_TYPE_Excel = 2
Const FILE_TYPE_PowerPoint = 3

'Valid file type lists
Const FILE_TYPE_DELIMITER = "|"
Dim g_strFileTypesWord
g_strFileTypesWord="|DOC|DOCX|"
Dim g_strFileTypesExcel
g_strFileTypesExcel="|XLS|XLSX|"
Dim g_strFileTypesPowerPoint
g_strFileTypesPowerPoint="|PPT|PPTX|"
'----------------------
' CONFIGURATION FINISH
'----------------------


'Call the main routine
Main
'--------------------
' MAIN ROUTINE START
'--------------------
Sub Main()
    Dim colArgs, intCounter, objFSO, strFilePath

    'Get the command line arguments for the script
    ' - Each chould be a file to be processed
    Set colArgs = Wscript.Arguments
    If colArgs.Count > 0 Then
        For intCounter = 0 to colArgs.Count - 1
            strFilePath = Wscript.Arguments(intCounter)

            'Check we have a valid file and process it
            Select Case CheckFile(strFilePath)
                Case CHECKFILE_OK
                    Select Case OfficeFileType(strFilePath)
                        Case FILE_TYPE_Word
                            SaveWordAsPDF strFilePath

                        Case FILE_TYPE_Excel
                            SaveExcelAsPDF strFilePath

                        Case FILE_TYPE_PowerPoint
                            SavePowerPointAsPDF strFilePath
                    End Select

                Case CHECKFILE_FileDoesNotExist
                    MsgBox """" & strFilePath & """", vbCritical, "File " & intCounter & " does not exist"
                    WScript.Quit

                Case CHECKFILE_NotMSOFile
                    MsgBox """" & strFilePath & """", vbCritical, "File " & intCounter & " is not a valid file type"
                    WScript.Quit
            End Select
        Next
    Else
        'If there's not even one argument/file to process then exit
        Msgbox "Please pass a file to this script", 48,"No File Provided"
        WScript.Quit
    End If


    'Display an optional summary message
    If SUMMARY_DISPLAY then
        If colArgs.Count > 1 then
            MsgBox CStr(colArgs.Count) & " files converted.", vbInformation, SUMMARY_TITLE
        Else
            MsgBox "1 file converted.", vbInformation, SUMMARY_TITLE
        End If
    End If
End Sub
'---------------------
' MAIN ROUTINE FINISH
'---------------------


'--------------------
' SUB-ROUTINES START
'--------------------
Sub SaveExcelAsPDF(p_strFilePath)
    'Save Excel file as a PDF

    'Initialise
    Dim objExcel, objWorkbook
    Set objExcel = CreateObject("Excel.Application")

    'Open the file
    Set objWorkbook = objExcel.Workbooks.Open(p_strFilePath)

    'Save the PDF
    objWorkbook.ExportAsFixedFormat EXCEL_PDF, PathOfPDF(p_strFilePath), EXCEL_QualityStandard, TRUE, FALSE, , , FALSE

    'Close the file and exit the application
    objWorkbook.Close FALSE
    objExcel.Quit
End Sub


Sub SaveWordAsPDF(p_strFilePath)
    'Save Word file as a PDF

    'Initialise
    Dim objWord, objDocument
    Set objWord = CreateObject("Word.Application")

    'Open the file
    Set objDocument = objWord.Documents.Open(p_strFilePath)

    'Save the PDF
    objDocument.SaveAs PathOfPDF(p_strFilePath), WORD_PDF

    'Close the file and exit the application
    objDocument.Close FALSE
    objWord.Quit
End Sub


Sub SavePowerPointAsPDF(p_strFilePath)
    'Save PowerPoint file as a PDF (slides only)

    'Initialise
    Dim objPowerPoint, objSlideDeck
    Set objPowerPoint = CreateObject("PowerPoint.Application")

    'PowerPoint errors if it isn't visible :-(
    'objPowerPoint.Visible = TRUE

    'Open the file
    Set objSlideDeck = objPowerPoint.Presentations.Open(p_strFilePath, , , FALSE)

    'Save the PDF
    'objSlideDeck.SaveAs PathOfPDF(p_strFilePath), POWERPOINT_PDF, True
    objSlideDeck.PrintOut PrintToFile:="TestPrnt"

    'Close the file and exit the application
    objSlideDeck.Close
    objPowerPoint.Quit
End Sub
'---------------------
' SUB-ROUTINES FINISH
'---------------------


'-----------------
' FUNCTIONS START
'-----------------
Function CheckFile(p_strFilePath)
    'Check file exists and is an office file (Excel, Word, PowerPoint)

    'Initialise
    Dim objFSO
    Set objFSO = CreateObject("Scripting.FileSystemObject")

    'Check the file exists and is an office file
    If IsOfficeFile(p_strFilePath) then
        If objFSO.FileExists(p_strFilePath) then
            CheckFile = CHECKFILE_OK
        Else
            CheckFile = CHECKFILE_FileDoesNotExist
        End If
    Else
        CheckFile = CHECKFILE_NotMSOFile
    End If
End Function


Function OfficeFileType(p_strFilePath)
    'Returns the type of office file, based upon file extension

    OfficeFileType = FILE_TYPE_NotOffice

    If IsWordFile(p_strFilePath) then
        OfficeFileType = FILE_TYPE_Word
    End If

    If IsExcelFile(p_strFilePath) then
        OfficeFileType = FILE_TYPE_Excel
    End If

    If IsPowerPointFile(p_strFilePath) then
        OfficeFileType = FILE_TYPE_PowerPoint
    End If
End Function

Function IsOfficeFile(p_strFilePath)
    'Returns true if a file is an office file (Excel, Word, PowerPoint)

    IsOfficeFile = IsWordFile(p_strFilePath) OR IsExcelFile(p_strFilePath) OR IsPowerPointFile(p_strFilePath)
End Function


Function IsWordFile(p_strFilePath)
    'Returns true if a file is a Word file

    IsWordFile = IsInList(GetFileExtension(p_strFilePath), g_strFileTypesWord)
End Function


Function IsExcelFile(p_strFilePath)
'Returns true if a file is an Excel file

    IsExcelFile = IsInList(GetFileExtension(p_strFilePath), g_strFileTypesExcel)
End Function


Function IsPowerPointFile(p_strFilePath)
'Returns true if a file is a PowerPoint file

    IsPowerPointFile = IsInList(GetFileExtension(p_strFilePath), g_strFileTypesPowerPoint)
End Function


Function IsInList(p_strSearchFor, p_strSearchIn)
    'Search a delimited list for a text string and return true if it's found

    Dim intResult

    intResult = InStr(1, p_strSearchIn, FILE_TYPE_DELIMITER & p_strSearchFor & FILE_TYPE_DELIMITER, vbTextCompare)

    If IsNull(intResult) then
        IsInList = FALSE
    Else
        If intResult = 0 then
            IsInList = FALSE
        Else
            IsInList = TRUE
        End If
    End If
End Function


Function GetFileExtension(p_strFilePath)
    'Return the file extension from a file path

    Dim objFSO
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    GetFileExtension = objFSO.GetExtensionName(p_strFilePath)
End Function


Function PathOfPDF(p_strOriginalFilePath)
    'Return the path for the PDF file
    'The path will be the same as the original file but with a different file extension

    Dim objFSO

    'Initialise
    Set objFSO = CreateObject("Scripting.FileSystemObject")

    'Build the file path
    'Set the directory
    PathOfPDF = objFSO.GetParentFolderName(p_strOriginalFilePath) & "\"

    'Add the original file name without the extension
    PathOfPDF = PathOfPDF & Left(objFSO.GetFileName(p_strOriginalFilePath), Len(objFSO.GetFileName(p_strOriginalFilePath)) - Len(objFSO.GetExtensionName(p_strOriginalFilePath)))

    'Finally add the the new file extension
    PathOfPDF = PathOfPDF & PDF_Extension
End Function
'------------------
' FUNCTIONS FINISH
'------------------

答案1

我当然需要使用该.PrintOut方法,但首先我必须将其设置PrintInBackGround为 false 并ActivePrinter设置为“Adobe PDF”。

这是 PowerPoint 子部分中“保存 PDF”部分的新代码。

'Save the PDF
'objSlideDeck.SaveAs PathOfPDF(p_strFilePath), POWERPOINT_PDF, True
objSlideDeck.PrintOptions.PrintInBackground = False
objSlideDeck.PrintOptions.ActivePrinter = "Adobe PDF"
objSlideDeck.PrintOut

上述方法感觉像是一种黑客行为 - 我可以使用相同的方法对 Word 和 Excel 进行操作 - 但它适用于打印 PowerPoint 墨水。

相关内容