Création de mail avec fichier PDF et sauvegarde des infos

Question

Mon niveau ne s'est toujours pas amélioré je vous sollicite. Je veux faire une fiche de réparation qui s'envoie en pdf au garage concerné et qui se stocke après dans un tableau récapitulatif... Je n'ai pas la patience.. Merci d'avance pour vos précieux conseils. Linette...

GVIALLES · Answer

Je te propose d'aménager le code VBA "creation" de la façon suivante : Option Explicit Sub creation() Dim sPDFName As String, sEMail As String 'On affecte un nom au PDF sPDFName = ThisWorkbook.Path & "\" & "FDR N°_" & Sheets("FDR").Range("D6").Value & "_" & Format(Now(), "yyyy_mm_dd hh_MM_ss") & ".pdf" 'On créé le PDF ActiveSheet.ExportAsFixedFormat xlTypePDF, sPDFName, xlQualityStandard, True, False 'On récupère l'eMail du garage sEMail = ThisWorkbook.Names("eMail_garage").RefersToRange.Value 'On envoie le PDF EnvoiPDF sPDFName, sEMail End Sub Sub EnvoiPDF(zPDFName As String, zEMail As String) Dim i As Long Dim oMsgApp As Outlook.Application Dim omsg As Outlook.MailItem Dim sListeDest As String Dim sFichier As String 'sFichier = Application.GetOpenFilename(, , "Sélectionner le fichier à envoyer") 'If sFichier = "" Then ' MsgBox "Aucun fichier sélectionné, opération annulée" 'Exit Sub 'End If Set oMsgApp = New Outlook.Application Set omsg = oMsgApp.CreateItem(olMailItem) With omsg .to = zEMail .CC = Sheets("param").Range("B2").Value .Attachments.Add zPDFName .Subject = "FDR N°" & "_" & Sheets("FDR").Range("D6").Value & "_" & Sheets("FDR").Range("I36").Value .body = "Bonjour," & Chr(10) & Chr(13) & "Veuillez trouver la fiche de réparation." & Chr(10) & Chr(13) & "Cordialement, " '.Send .Display End With oMsgApp.Quit Set oMsgApp = Nothing Set omsg = Nothing MsgBox "Le mail a été envoyé." End Sub Je joins le classeur modifié pour mes tests...

GVIALLES · Answer

Linette,

Pour le second 'soucis', il te suffit de décommenter la ligne contenant la méthode '.send' et de supprimer (ou commenter) la ligne contenant la méthode ".display" que j'ai mis en place pour éviter les envois intempestifs de mail lors de mes tests :

Pour le premier 'soucis', je te propose d'aménager le code de la procédure 'creation' pour ajouter une séquence de recopie des informations dans le tableau de suivi :

Sub creation()
    Dim sPDFName As String, sEMail As String
    'On affecte un nom au PDF
    sPDFName = ThisWorkbook.Path & "\" & "FDR N°_" & Sheets("FDR").Range("D6").Value & "_" & Format(Now(), "yyyy_mm_dd hh_MM_ss") & ".pdf"

    'On créé le PDF
    ActiveSheet.ExportAsFixedFormat xlTypePDF, sPDFName, xlQualityStandard, True, False

    'On récupère l'eMail du garage
    sEMail = ThisWorkbook.Names("eMail_garage").RefersToRange.Value

    'On envoie le PDF
    EnvoiPDF sPDFName, sEMail

    'On ajoute une ligne au tableau de suivi
    Dim oTbl As ListObject, oListRow As ListRow
    Dim oRange As Range
    Dim aTravaux() As Variant, sTravaux As String, i As Integer

    Set oTbl = ThisWorkbook.Worksheets("suivi des réparations").ListObjects("Tblsuivi")
    Set oListRow = oTbl.ListRows.Add
    With oListRow
        .Range(1) = ThisWorkbook.Worksheets("FDR").Range("B6").Value
        .Range(2) = ThisWorkbook.Worksheets("FDR").Range("D6").Value
        .Range(3) = ThisWorkbook.Worksheets("FDR").Range("F6").Value
        .Range(4) = ThisWorkbook.Worksheets("FDR").Range("I35").Value
        .Range(5) = ThisWorkbook.Worksheets("FDR").Range("F9").Value

        'On concatène les lignes significatives de "Travaux demandés"
        Set oRange = ThisWorkbook.Worksheets("FDR").Range("D16:D31")
        aTravaux() = oRange.Value
        For i = 1 To UBound(aTravaux)
            If Not IsEmpty(aTravaux(i, 1)) Then
                sTravaux = sTravaux & aTravaux(i, 1) & vbCr
            End If
        Next
        .Range(6) = Left(sTravaux, Len(sTravaux) - 1)
    End With

End Sub