Re : Convertir une feuille excel en PDF
À date le code le plus «élégant» que j'ai trouvé ressemble à ceci. Par contre, lors de la création du tempPS file, ca me donne une erreur. j'imagine qu'il y a d'autres façons de procéder.
Public Sub CreatePdf()
On Error GoTo err_cmdCreatePdf_Click
'Creates .pdf from current worksheet.
'Derives path & file name from worksheet properties.
Dim strPsFileName As String
Dim strPdfFileName As String
Dim strPsFileNameDoubleQuotes As String
Dim strPdfFileNameDoubleQuotes As String
Dim strFullWorkbookNameActiveFolder As String
Dim strAuditFolder As String
Dim strFileName As String
Dim strDefaultActivePrinter As String
Dim strDistillerCall As String
Dim ReturnValue As Variant
Dim intStartPositionOfWorksheetName As Integer
Dim intEndPositionOfWorksheetName As Integer
Dim intLengthOfFileName As Integer
' First a PS file must be created. Then PS will be converted to PDF
' Uncheck "Do not send fonts to Distiller" option in the Distiller Properties
' Define the postscript and .pdf file names.
'Briefly displays form to let user know the adobe file is being created.
'UserForms.Add("ShowWorking").Show
' Saves the workbook before creating .pdf
ActiveWorkbook.Save
'ActiveWorkbook.Name property is the worksheet file name including path & .xls extension
strfullActiveWorkbookName = ActiveWorkbook.FullName
' Substring commands to extract path of audit & workbook filename
intStartPositionOfWorksheetName = InStrRev(strfullActiveWorkbookName, "\") + 1
intEndPositionOfWorksheetName = InStrRev(strfullActiveWorkbookName, ".xls") - 1
intLengthOfFileName = (intEndPositionOfWorksheetName - intStartPositionOfWorksheetName) + 1
strAuditFolder = Left(strfullActiveWorkbookName, (intStartPositionOfWorksheetName - 1))
strFileName = Mid(strfullActiveWorkbookName, intStartPositionOfWorksheetName, intLengthOfFileName)
'Stores filename of the temporary postscript to variable.
strPsFileName = strAuditFolder & "TempPsFile.ps"
' Stores filename of .pdf to variable.
strPdfFileName = strAuditFolder & strFileName & ".pdf"
' MsgBox Prompt:="Expect a short delay while (" & strPdfFileName & ") is created", Title:="PDF Creation"
'Stores user's default active printer for workbook for later restoration.
strDefaultActivePrinter = Application.ActivePrinter
'Prints to postscript file
ActiveWorkbook.PrintOut Copies:=1, Collate:=True, _
ActivePrinter:="Adobe PDF", _
PrintToFile:=True, PrToFileName:=strPsFileName
'Restores user's active printer to former setting.
Application.ActivePrinter = strDefaultActivePrinter
'Add double quotes around the PS filename and PDF filename
'necessary for Adobe Distiller call below.
strPsFileNameDoubleQuotes = Chr(34) & strPsFileName & Chr(34)
strPdfFileNameDoubleQuotes = Chr(34) & strPdfFileName & Chr(34)
'Call the Acrobat Distiller to distill the PS file. ReturnValue is zero
'if the application doesn't open correctly:
DistillerCall = "c:\Program Files\Adobe\Acrobat 8.0\Distillr\Acrodist.exe" & " /n /q /o" & strPdfFileNameDoubleQuotes & " " & strPsFileNameDoubleQuotes
ReturnValue = Shell(DistillerCall, vbNormalFocus)
If ReturnValue = 0 Then MsgBox "Creation of " & PdfFileName & "failed."
exit_cmdCreatePdf_Click:
Exit Sub
err_cmdCreatePdf_Click:
MsgBox Err.Description & " (" & Err.Number & ")"
GoTo exit_cmdCreatePdf_Click
End Sub