Каждый день я печатаю несколько файлов .pptx и .docx в файлы .pdf. Я искал в Интернете, чтобы найти сценарий, связанный здесь. Я также вставлю скрипт ниже.
Скрипт отлично работает при создании файлов .pdf. Тем не менее, мне нужно "чернила" для печати в .pdf файлах. Насколько я знаю, скрипт удаляет "чернила", потому что он использует .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
'------------------