Todos os dias, imprimo um punhado de arquivos .pptx e .docx em arquivos .pdf. Eu vasculhei a internet para encontrar o script vinculado aqui . Eu vou colar o script abaixo também.
O script funciona excelente ao gerar arquivos .pdf. No entanto, eu preciso que a "tinta" seja impressa nos arquivos .pdf também. Até onde sei, o script remove a "tinta" porque usa métodos .SaveAs em vez de .PrintOut .
Os arquivos .pptx são mais prementes, então tentei corrigi-los primeiro. Eu mudei essa linha
objSlideDeck.SaveAs PathOfPDF(p_strFilePath), POWERPOINT_PDF, True
para esta linha
objSlideDeck.PrintOut PrintToFile:="TestPrnt"
mas recebo o seguinte erro.
Comofaçoparacorrigirisso?Existeumaboareferênciasobreousode.PrintOutparaimprimirem.pdf?EutenhoumalicençadoAcrobatepossoimprimirapartirdomenuFile.
AquiestáoScriptVB.
'http://www.thoughtasylum.com/blog/2012/12/20/vbscript-to-convert-microsoft-office-files-word-excel-powerp.htmlOptionExplicit'---------------------'CONFIGURATIONSTART'---------------------'DisplayasummaryinamessageboxwhentheconversionsarecompleteConstSUMMARY_DISPLAY=TRUEConstSUMMARY_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
'------------------