Export PDF sans passer par l'imprimante PDF?

Tanid

XLDnaute Nouveau
Bonjour à tous!

Je suis devant un dilemne... Au travail, nous avons fait passer à tous nos employés (1200) un test de connaissance. J'ai monté un rapport dans excel 2007 qui reprend leurs réponses, leur donne leur résultats, le corrigé, etc. Le tout avec des formules et des macros. Afin que le résultat soit professionnel, j'ai appliqué une mise en page précise pour calibrer le produit final.

Voici où je bloque: je dois automatiser la production du rapport. Je n'ai pas de problème pour aller chercher les données, etc, mais je dois faire un export PDF.

J'ai trouvé quelques macros qui utilisent l'imprimante PDF, mais le résultat ne reprends pas ma mise en page, ni les liens hypertextes du document. Par contre, lorsque j'utilise, l'onglet Acrobat (dans le ruban), le bouton "créer un fichier PDF", tout fonctionne à merveille. Je ne comprends pas. Si quelqu'un avait une idée de comment appeler cette fonciton plutôt que l'imprimante, ça m'aiderait beaucoup!

En fait, idéalement, le mieux serait d'utiliser "Créer et joindre à un message" puis d'utiliser la valeur de la cellule H2 comme destinataire...

J'espère que je vous aurez une idée... Je me vois mal me taper 1200 exports à la main :eek: Merci d'avance!!!
 

chris

XLDnaute Barbatruc
Re : Export PDF sans passer par l'imprimante PDF?

Bonjour

Hyperliens PDF : j'ai été confronté à ce genre de problème il y a quelques années (cela a peut-être changé depuis) mais le bouton acrobat correspond à une macro d'Adobe. Elle gère au plus près le format Word ou Excel selon le cas et donc aussi les hyperliens tandis que l'utilisation en mode imprimante n'est pas supposée faire des liens.

Une piste à explorer est de sauvegarder en format html : de mémoire la génération de PDF depuis ce format gère les hyperliens...
 

Tanid

XLDnaute Nouveau
Re : Export PDF sans passer par l'imprimante PDF?

Bon, après moult recherche et bricolages, j'ai réussi à faire ce que je voulais... :cool:

Il ne me reste que deux choses à faire:
- Associer ma macro de copie de valeurs avec celle d'export PDF
- Créer une loupe jusqu'à ce que la feuille DFI_resultats3 soit vide...

Est-ce que quelqu'un peut m'aider? J'en ai fait un bon morceau, mais là dans les boucles je sèche complètement!!!!

Voici le code de copie de valeurs, qui se trouve sur la feuille 1:

Code:
Sub Copie_colle_valeurs()
'
' Copie_colle_valeurs Macro
'

'
    Sheets("DFI_resultats3").Select
    Rows("1:1").Select
    Selection.Delete Shift:=xlUp
    Range("A1:CM1").Select
    Selection.Copy
    Sheets("Rapport").Select
    Range("J2").Select
    ActiveSheet.Paste
  
    
End Sub

Ensuite, la macro d'export PDF. La commande d'appel est sur ma feuille 1 également:

Code:
Private Sub CommandButton3_Click()
    Call RDB_Selection_Range_To_PDF_And_Create_Mail
End Sub

Puis j'ai la première partie dans le module 1:

Code:
Sub RDB_Selection_Range_To_PDF_And_Create_Mail()
    Dim FileName As String

    If ActiveWindow.SelectedSheets.Count > 1 Then
        MsgBox "There is more then one sheet selected," & vbNewLine & _
               "ungroup the sheets and try the macro again"
    Else
        'Call the function with the correct arguments


        'For a fixed range use this line
        FileName = RDB_Create_PDF(Range("A1:I280"), "", True, False)

        'For the selection use this line
        'FileName = RDB_Create_PDF(Selection, "", True, True)

        'For a fixed file name and overwrite it each time you run the macro use
        'RDB_Create_PDF(Selection, "C:\Users\Ron\Test\YourPdfFile.pdf", True, True)

        If FileName <> "" Then
            RDB_Mail_PDF_Outlook FileName, "ron@debruin.nl", "Défi Expert - Votre résultat", _
                                 "Merci d'avoir répondu au questionnaire!" _
                               & vbNewLine & vbNewLine & "Le service de la formation", True
        Else
            MsgBox "Not possible to create the PDF, possible reasons:" & vbNewLine & _
                   "Microsoft Add-in is not installed" & vbNewLine & _
                   "You Canceled the GetSaveAsFilename dialog" & vbNewLine & _
                   "The path to Save the file in arg 2 is not correct" & vbNewLine & _
                   "You didn't want to overwrite the existing PDF if it exist"
        End If
    End If
End Sub

La portion de création du PDF et de Outlook est dans le module 2:

Code:
Option Explicit

'The code below are used by the macros in the other two modules
'Do not change the code in the functions in this module

Function RDB_Create_PDF(Myvar As Object, FixedFilePathName As String, _
                        OverwriteIfFileExist As Boolean, OpenPDFAfterPublish As Boolean) As String
    Dim FileFormatstr As String
    Dim Fname As Variant

    'Test If the Microsoft Add-in is installed
    If Dir(Environ("commonprogramfiles") & "\Microsoft Shared\OFFICE" _
         & Format(Val(Application.Version), "00") & "\EXP_PDF.DLL") <> "" Then

        If FixedFilePathName = "" Then
            'Open the GetSaveAsFilename dialog to enter a file name for the pdf
            FileFormatstr = "PDF Files (*.pdf), *.pdf"
            Fname = ThisWorkbook.Path & "\" & Range("G10").Value & ".pdf"
        End If

        'If OverwriteIfFileExist = False we test if the PDF
        'already exist in the folder and Exit the function if that is True
        If OverwriteIfFileExist = False Then
            If Dir(Fname) <> "" Then Exit Function
        End If

        'Now the file name is correct we Publish to PDF
        On Error Resume Next
        Myvar.ExportAsFixedFormat _
                Type:=xlTypePDF, _
                FileName:=Fname, _
                Quality:=xlQualityStandard, _
                IncludeDocProperties:=True, _
                IgnorePrintAreas:=False, _
                OpenAfterPublish:=OpenPDFAfterPublish
        On Error GoTo 0

        'If Publish is Ok the function will return the file name
        If Dir(Fname) <> "" Then RDB_Create_PDF = Fname
    End If
End Function



Function RDB_Mail_PDF_Outlook(FileNamePDF As String, StrTo As String, _
                              StrSubject As String, StrBody As String, Send As Boolean)
    Dim OutApp As Object
    Dim OutMail As Object

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    On Error Resume Next
    With OutMail
        .To = Range("CV2").Value
        .CC = ""
        .BCC = ""
        .Subject = StrSubject
        .Body = StrBody
        .Attachments.Add FileNamePDF
        If Send = True Then
            .Send
        Else
            .Display
        End If
    End With
    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing
End Function

Voilà... Je vous joins un fichier au cas où tout ça ne soit pas super clair...

Merci!!!!!:D
 

Pièces jointes

  • Rapport_DE_Test macros.xlsm
    94.7 KB · Affichages: 63

Discussions similaires

Statistiques des forums

Discussions
312 472
Messages
2 088 715
Membres
103 932
dernier inscrit
clotilde26