我每天都会将一些 .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 墨水。