Insérer des tableaux d'un classeur extérieur dans un mail automatique

Question

Bonjour à tous, J'ai créer une macro dans mon classeur "Mails" ci-joint qui envoie des mails automatiquement lorsqu'on appuie sur le bouton "Préparer les mails sans envoie" à partir des informations dans l'onglet "Mails". Je voudrais pour mon mails 2 dans l'onglet "Mails" mettre dans la colonne "Mails", qui contient le corps du message, insérer quatre tableaux qui se trouve dans mon classeur "Tableaux" ci-joint. Donc après "Voici mes deux tableaux " dans ma colonne "Mail" du Mail 2 j'aimerais copier la plage B4:I26 de mon classeur "Tableaux" pour avoir mes deux premiers tableaux et par la suite copier la plage V4:AJ26 de mon classeur "Tableaux" pour avoir mes deux autres tableaux. J'espère avoir été claire et sinon n'hésitez pas si vous avez besoin de plus de précision. Merci d'avance pour votre aide...

GVIALLES · Accepted Answer

Laguilo,

Tu trouveras ma proposition en P.J.

J'ai fait les aménagements suivants :

Dans le classeur 'Tableaux' j'ai affecté des noms Tableau_1, Tableau_2,Tableau_3, Tableau_4 à tes 4 tableaux.

Dans le classeur 'Mail-GVS'

dans le volet 'Paramétrages' j'ai créé un nouveau bouton qui stocke le nom et le dossier du classeur 'Tableaux' dans la cellule nommée 'wbTableau'.

j'ai créé le code suivant qui créé des fichiers images a partir d'un tableau

Sub creerImage(oTableau As Range, sPNGFileName As String)
    Dim oFS As filesystemobject
    Dim oSheet As Worksheet
    Dim oShape As Shape
    Dim oChart As Object

    'On supprime le fichier PNG s'il existe
    Set oFS = CreateObject("Scripting.FileSystemObject")
    If oFS.FileExists(sPNGFileName) Then
        oFS.DeleteFile sPNGFileName, True
    End If

    'On copie le tableau en tant qu'image
    oTableau.CopyPicture

    'On insère l'image dans un objet chart provisoire
    Set oSheet = oTableau.Worksheet
    Set oChart = oSheet.ChartObjects.Add(oTableau.Left, oTableau.Top + Application.CentimetersToPoints(20), oTableau.Width, oTableau.Height)
    With oChart
        .Chart.ChartArea.Select
        .Chart.Paste
        'On crée le fichier image
        .Chart.Export sPNGFileName, "PNG"
        'On détruit l'objet chart
        .Delete
    End With
End Sub

j'ai aménagé le code de la procédure 'Mail' pour créer les 4 fichiers images des 4 tableaux et les inclure dans l'appel à la procédure 'EnvoyerEMail' :

Sub Mail()

    Const cImageTableau1 = "Tableau_1.png"
    Const cImageTableau2 = "Tableau_2.png"
    Const cImageTableau3 = "Tableau_3.png"
    Const cImageTableau4 = "Tableau_4.png"

    Dim oWB As Workbook
    Dim oTableau As Range
    Dim sWBPath As String

    Application.ScreenUpdating = False
    'On récupère le chemin du classeur 'Tableaux'
    sWBPath = ThisWorkbook.Names("WBTableaux").RefersToRange.Value
    'On ouvre le classeur 'Tableaux'
    Set oWB = Application.Workbooks.Open(sWBPath)

    'On créé un fichier image du tableau 1
    Set oTableau = oWB.Names("Tableau_1").RefersToRange
    creerImage oTableau, cImageTableau1

    'On créé un fichier image du tableau 2
    Set oTableau = oWB.Names("Tableau_2").RefersToRange
    creerImage oTableau, cImageTableau2

    'On créé un fichier image du tableau 3
    Set oTableau = oWB.Names("Tableau_3").RefersToRange
    creerImage oTableau, cImageTableau3

    'On créé un fichier image du tableau 4
    Set oTableau = oWB.Names("Tableau_4").RefersToRange
    creerImage oTableau, cImageTableau4

    oWB.Close False
    Application.ScreenUpdating = True

    Worksheets("Mails").Activate

    i = 2

    While i < 1000

        titre = Worksheets("Mails").Cells(i, 1).Value
        Destinataire = Worksheets("Mails").Cells(i, 2).Value
        CC = Worksheets("Mails").Cells(i, 3).Value
        Texte = Worksheets("Mails").Cells(i, 4).Value
        NB_Piece = Worksheets("Mails").Cells(i, 5)
        mois = Range("Mois_av").Value
        année = Range("Année").Value

        'On envoie le mail en spécifiant les 2 fichiers images
        Call EnvoyerEmail(titre, Destinataire, CC, Texte, NB_Piece, i, mois, année, cImageTableau1, cImageTableau2, cImageTableau3, cImageTableau4)

        i = i + 1

        If IsEmpty(Cells(i, 1)) Then i = 1000

    Wend

j'ai aménagé le code de la procédure 'EnvoyerMail' pour inclure les images dans le corps du mail :

Sub EnvoyerEmail(ByVal Sujet As String, ByVal Destinataire As String, ByVal Copie As String, ByVal ContenuEmail As String, ByVal Nbpiece As Integer, ByVal ligne As Integer, ByVal mois As String, ByVal année As String, ImgTableau1 As String, ImgTableau2 As String, ImgTableau3 As String, ImgTableau4 As String)
'par Excel-Malin.com ( https://excel-malin.com ) - aménagé par GVIALLES (https://excellons.org)

    On Error GoTo EnvoyerEmailErreur

    'définition des variables
    Dim oOutlook As Outlook.Application
    Dim WasOutlookOpen As Boolean
    Dim oMailItem As Outlook.MailItem
    Dim oAttachment As Outlook.Attachment

    Dim Body As Variant
    Dim a() As String
    Dim Piece_jointe As String

    Body = ContenuEmail

    'vérification si le Contenu du mail n'est pas vide. Si oui, email n'est pas envoyé. Si vous voulez pouvoir envoyer les email vides, mettez en commentaire les 4 lignes de code qui suivent.
    If (Body = False) Then
        MsgBox "Mail non envoyé car vide", vbOKOnly, "Message"
        Exit Sub
       End If

    'préparer Outlook
    PreparerOutlook oOutlook
    Set oMailItem = oOutlook.CreateItem(0)

    'création de l'email
    With oMailItem

        .To = Destinataire
        .Subject = Sujet
        .CC = Copie
        .HTMLBody = "Bonjour, <br><br>" _
                  & "Voici mes deux premiers tableaux:<br><br>" _

        'On ajoute l'image du tableau 1 en mode caché
        Set oAttachment = .Attachments.Add(ImgTableau1, olByValue, 0)
        'On extrait le nom de la pièce jointe
        Piece_jointe = oAttachment.DisplayName
        'On ajoute l'image du tableau 1 dans le corps du mail
        .HTMLBody = .HTMLBody & "<img src='" & Piece_jointe & "'>   "

        'On ajoute l'image du tableau 2 en mode caché
        Set oAttachment = .Attachments.Add(ImgTableau2, olByValue, 0)
        'On extrait le nom de la pièce jointe
        Piece_jointe = oAttachment.DisplayName
        'On ajoute l'image du tableau 1 dans le corps du mail
        .HTMLBody = .HTMLBody & "<img src='" & Piece_jointe & "'><br><br>"

        .HTMLBody = .HTMLBody & "Et les deux autres:<br><br>"

        'On ajoute l'image du tableau 3 en mode caché
        Set oAttachment = .Attachments.Add(ImgTableau3, olByValue, 0)
        'On extrait le nom de la pièce jointe
        Piece_jointe = oAttachment.DisplayName
        'On ajoute l'image du tableau 1 dans le corps du mail
        .HTMLBody = .HTMLBody & "<img src='" & Piece_jointe & "'>   "

        'On ajoute l'image du tableau 4 en mode caché
        Set oAttachment = .Attachments.Add(ImgTableau4, olByValue, 0)
        'On extrait le nom de la pièce jointe
        Piece_jointe = oAttachment.DisplayName
        'On ajoute l'image du tableau 1 dans le corps du mail
        .HTMLBody = .HTMLBody & "<img src='" & Piece_jointe & "'><br><br>"

        .HTMLBody = .HTMLBody & "A votre disposition pour tout complément d'information. <br><br>" _
                              & "Cordialement, <br><br>"

       '.Save      '<- sauvegarde l'email avant l'envoi (pour ne pas le sauvegarder, mettez cette ligne en commentaire)
       '.Send      '<- envoie l'email (si vous voulez seulement préparer l'email et l'envoyer manuellement, mettez cette ligne en commentaire)
        .Display   '<- affiche l'email (si vous ne voulez pas l'afficher, mettez cette ligne en commentaire)
    End With

   'nettoyage...
    If (Not (oMailItem Is Nothing)) Then Set oMailItem = Nothing
    If (Not (oOutlook Is Nothing)) Then Set oOutlook = Nothing

   Exit Sub

EnvoyerEmailErreur:
    If (Not (oMailItem Is Nothing)) Then Set oMailItem = Nothing
    If (Not (oOutlook Is Nothing)) Then Set oOutlook = Nothing

    MsgBox "Le mail n'a pas pu être envoyé...", vbCritical, "Erreur"
End Sub

52languilo.zip (102.25 Ko)

GVIALLES · Answer

Peux-tu apporter la précision suivante : tu voudrais que les tableaux soient en pièces jointes du mail ou bien soient dans le corps du mail ...

GVIALLES · Answer

Laguilo, Autre précision : le classeur 'Tableaux' est-il dans le même dossier que le classeur 'mails' ...

GVIALLES · Answer

Laguilo, Encore une question : dans ton exemple, tu as prévu 2 rédactions différentes dans le corps du mail. Les tableaux sont-ils à inclure quelque soit le type de mail ...