Option Compare Database ' ** Access Toolbox Module ** ' on 2017-02-28, ' @author: Olivier Massot ' V 1.0 ' Operations on PDF Files ' ! Requires AT_Access ' ! Requires PDF Creator 1.7.0 Public Function export_pdf(report_name As String, _ dir_path As String, _ Optional pdf_name As String = "", _ Optional filter As String = "", _ Optional replace As Boolean = True) As Boolean On Error GoTo err export_pdf = False If Not report_exists(report_name) Then GoTo errNotExist If Right(dir_path, 1) <> "\" Then dir_path = dir_path & "\" If Dir(dir_path, vbDirectory) = "" Then GoTo errDirNotExist If Not Len(pdf_name) > 0 Then pdf_name = report_name If Right(nomPDF, 4) <> ".pdf" Then pdf_name = pdf_name & ".pdf" If Dir(dir_path & pdf_name) <> "" Then If replace = False Then If MsgBox("Un fichier PDF portant ce nom existe déjà, voulez-vous l'écraser?", vbYesNo) = vbNo Then GoTo cancel_ End If End If On Error GoTo errDelFile Kill repCible & nomPDF On Error GoTo err End If If Not report_is_opened(report_name) Then DoCmd.OpenReport nomEtat, acViewNormal, , filter, acHidden DoCmd.OutputTo acOutputReport, report_name, acFormatPDF, dir_path & pdf_name DoCmd.Close acReport, report_name, acSaveNo exportPDF = True fin: Exit Function errNotExist: MsgBox "Erreur: l'état demandé n'existe pas ('" & report_name & "')" GoTo fin errDirNotExist: MsgBox "Erreur: le répertoire cible '" & repCible & "' n'existe pas, veuillez le créer ou contacter un administrateur." GoTo fin cancel_: MsgBox "Export PDF annulé" GoTo fin errDelFile: MsgBox "Impossible de supprimer le fichier existant, il est peut-être ouvert?" & vbNewLine & "Opération annulée" GoTo fin err: MsgBox "Erreur de l'export PDF : " & vbNewLine & err.Description GoTo fin End Function Public Sub pdf_append(ByVal path_pdf1 As String, ByVal path_pdf2 As String, ByVal result_path As String) 'Créé le fichier PDF 'result_path' en indérant le PDF 2 à la suite du PDF 1 ' usage: ' >> pdf_append "C:\path\to\file1.pdf", "C:\path\to\file2.pdf", "C:\path\to\file1&2.pdf" ' ATTENTION: nécessite PDF Creator 1.7 On Error GoTo err Dim oPdf As Object On Error GoTo errPdfforge Set oPdf = CreateObject("pdfforge.pdf.pdf") On Error GoTo err oPdf.MergePDFFiles_2 Array(path_pdf1, path_pdf2), result_path, True fin: Exit Sub err: MsgBox "Erreur lors de la fusion des pdfs: " & err.Description GoTo fin errPdfforge: MsgBox "Erreur: Pdfforge 1.7 est nécessaire pour utiliser cette fonction, opération annulée." & vbNewLine & _ "Essayez d'installer PDF Creator 1.7.0" GoTo fin End Sub Public Sub ExcelVersPDF(cheminExcel As String, Optional cheminPDF As String = "", Optional feuille As Integer = 1, Optional ecraser As Boolean = True) 'exporte la page demandée du document excel en pdf '! Requires Micosoft Excel XX.X Object Library Dim objExcel As Excel.Application Dim objExcelDoc As Excel.Workbook Dim objExcelFeuille As Excel.Worksheet If Dir(cheminExcel) = "" Then GoTo errSource If Dir(repFichier(cheminPDF), vbDirectory) = "" Then GoTo errRepCible If Len(cheminPDF) = 0 Then cheminPDF = Split(cheminExcel, ".")(0) & ".pdf" If feuille < 1 Then feuille = 1 If Right(cheminPDF, 4) <> ".pdf" Then cheminPDF = cheminPDF & ".pdf" If Dir(cheminPDF) <> "" Then If ecraser = False Then If MsgBox("Un fichier portant ce nom existe déjà, voulez-vous le remplacer", vbYesNo) = vbNo Then GoTo annule End If On Error GoTo errSuppr Kill cheminPDF On Error GoTo err End If Set objExcel = CreateObject("Excel.Application") objExcel.Visible = True Set objExcelDoc = objExcel.Workbooks.Open(cheminExcel) If Not objExcel Is Nothing Then objExcelDoc.ExportAsFixedFormat xlTypePDF, cheminPDF, xlQualityStandard, , , feuille, feuille, False End If fin: On Error Resume Next objExcelDoc.Close False objExcel.Quit Set objExcelDoc = Nothing Set objExcel = Nothing Exit Sub err: MsgBox "Erreur: " & err.Description GoTo fin errSource: MsgBox "Erreur: Fichier Excel (.xls) introuvable" GoTo fin errSuppr: MsgBox "Impossible de supprimer le fichier existant, il est peut-être ouvert?" & vbNewLine & "Opération annulée" GoTo fin annule: MsgBox "Opération annulée" GoTo fin errRepCible: MsgBox "Erreur: le répertoire cible n'existe pas, veuillez le créer ou prévenir un administrateur" GoTo fin End Sub Public Sub WordVersPDF(cheminWord As String, Optional cheminPDF As String, Optional ecraser As Boolean = True) 'exporte la page demandée du document word en pdf '! Requires Micosoft Word XX.X Object Library Dim objWord As Word.Application Dim objWordDoc As Word.Document If Dir(cheminWord) = "" Then GoTo errSource If Dir(repFichier(cheminPDF), vbDirectory) = "" Then GoTo errRepCible If Len(cheminPDF) = 0 Then cheminPDF = Split(cheminWord, ".")(0) & ".pdf" If Right(cheminPDF, 4) <> ".pdf" Then cheminPDF = cheminPDF & ".pdf" If Dir(cheminPDF) <> "" Then If ecraser = False Then If MsgBox("Un fichier portant ce nom existe déjà, voulez-vous le remplacer", vbYesNo) = vbNo Then GoTo annule End If On Error GoTo errSuppr Kill cheminPDF On Error GoTo err End If Set objWord = CreateObject("Word.Application") objWord.Visible = True Set objWordDoc = objWord.Documents.Open(cheminWord) If Not objWord Is Nothing Then objWordDoc.ExportAsFixedFormat cheminPDF, wdExportFormatPDF, False, wdExportOptimizeForPrint, wdExportAllDocument End If fin: On Error Resume Next objWordDoc.Close False objWord.Quit Set objWordDoc = Nothing Set objWord = Nothing Exit Sub err: MsgBox "Erreur: " & err.Description GoTo fin errSource: MsgBox "Erreur: Fichier Word (.doc / .docx) introuvable" GoTo fin errSuppr: MsgBox "Impossible de supprimer le fichier existant, il est peut-être ouvert?" & vbNewLine & "Opération annulée" GoTo fin annule: MsgBox "Opération annulée" GoTo fin errRepCible: MsgBox "Erreur: le répertoire cible n'existe pas, veuillez le créer ou prévenir un administrateur" GoTo fin End Sub