XL 2019 Envoyer un mail a partir d'Excel avec une image dans le corps

My<3

XLDnaute Junior
Bonjour, je prends gout venir vous consulter! Je fais appel a vos grande connaissance en Excel et VBA

J'ai un document Excel dans lequel j'ai des informations a compléter, une fois les infos compléter je veux qu'un PDF soit enregistrer dans un dossier précis jusque la ca va.

Je voudrais ensuite envoyer un mail Outlook a partir de ce fichier a l'aide d'un bouton. Ce bouton activerais les commandes d'enregistrer le pdf et l'envois du mail

Dans le mail je voudrais que
l'objet sois l'information écrite dans la cellule A1.
Le message sois la capture d'image des cellules A1 a J47 (sans que cette image sois nécessairement enregistrer au que ce soit)
 

Pièces jointes

  • TestEnvois.xlsm
    18.4 KB · Affichages: 13

My<3

XLDnaute Junior
J'ai ce code qui fonctionne bien et celui du PDF fonctionne bien lorsque je les utilise un a un mais lorsque je les joint sur un bouton une fois que les étapes sont fais mon bouton disparait et un message Mémoire insuffisante est-ce parce que le code enregistre tout

[
Code:
CODE=vb]Sub Mail_small_Text_And_JPG_Range_Outlook()
    'This macro use the function named : CopyRangeToJPG
    Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String
    Dim MakeJPG As String

    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With

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

               
    'Create JPG file of the range
    'Only enter the Sheet name and the range address
    MakeJPG = CopyRangeToJPG("MEP", "A1:J47")

    If MakeJPG = "" Then
        MsgBox "Something go wrong, we can't create the mail"
        With Application
            .EnableEvents = True
            .ScreenUpdating = True
        End With
        Exit Sub
    End If

    On Error Resume Next
    With OutMail
        .To = "mep@123l.com"
        .CC = ""
        .BCC = ""
        .Subject = Range("MEP!A1").Value & " MISE EN FABRICATION"
        .Attachments.Add MakeJPG, 1, 0
        'Note: Change the width and height as needed
        .HTMLBody = "<html><p>" & strbody & "</p><img src=""cid:NamePicture.jpg"" width=700 height=800></html>"
        .Display 'or use .Send
    End With
    On Error GoTo 0

    Kill MakeJPG

    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With

    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub


Function CopyRangeToJPG(NameWorksheet As String, RangeAddress As String) As String

    Dim PictureRange As Range

    With ActiveWorkbook
        On Error Resume Next
        .Worksheets(NameWorksheet).Activate
        Set PictureRange = .Worksheets(NameWorksheet).Range(RangeAddress)
       
        If PictureRange Is Nothing Then
            MsgBox "Sorry this is not a correct range"
            On Error GoTo 0
            Exit Function
        End If
       
        PictureRange.CopyPicture
        With .Worksheets(NameWorksheet).ChartObjects.Add(PictureRange.Left, PictureRange.Top, PictureRange.Width, PictureRange.Height)
            .Activate
            .Chart.Paste
            .Chart.Export Environ$("temp") & Application.PathSeparator & "NamePicture.jpg", "JPG"
        End With
        .Worksheets(NameWorksheet).ChartObjects(.Worksheets(NameWorksheet).ChartObjects.Count).Delete
    End With
   
    CopyRangeToJPG = Environ$("temp") & Application.PathSeparator & "NamePicture.jpg"
    Set PictureRange = Nothing
End Function
[/CODE]
 

Pièces jointes

  • TestEnvois.xlsm
    21.5 KB · Affichages: 9
Dernière édition:

My<3

XLDnaute Junior
Salut, à toi de voir .....
Merci et si j'aimerais ajouter une ligne vide entre les images je marque ca comment

j'éprouve une difficulté lorsque j'applique dans mon fichier et je n'arrive pas a solutionné.
Est-ce parce que je nomme mes onglets?

J'ai aussi deux autres pages ou j'aimerais qu'elle ne s'imprime pas en PDF mais qu'elles s'envoient en mail a l'aide d'un bouton et une fois envoyer tous les informations sons effacer
 

Pièces jointes

  • Copie MiseEnProduction.xlsm
    69.5 KB · Affichages: 8
Dernière édition:

kiki29

XLDnaute Barbatruc
Salut, ajout de qqch comme : ....800>" & "<br/><br/><br/><br/>" & _ ...
dans la chaine HTMLBody
VB:
.HTMLBody = "<html><p>" & _
                    strbody & "</p><img src=""cid:NamePicture(1).jpg"" width=700 height=800>" & _
                    "<br/><br/><br/><br/>" & _
                    strbody & "</p><img src=""cid:NamePicture(2).jpg"" width=700 height=800></html>"

Feuil1 et Feuil2 sont les CodeNames des onglets.
l'emploi des CodeNames permet de déplacer, renommer les onglets sans avoir à retoucher au code VBA. Voir CodeName.png ci-dessous cerclé de Bleu le CodeName, de Rouge le nom d'Onglet.

Pourrais-tu fournir une liste avec :
Nom d'onglet et CodeName des feuilles envoyées en JPEG et imprimées en PDF ?
Nom d'onglet et CodeName des feuilles envoyées en JPEG uniquement ?
 

Pièces jointes

  • CodeName.png
    CodeName.png
    74.9 KB · Affichages: 42
Dernière édition:

My<3

XLDnaute Junior
Salut, ajout de qqch comme : ....800>" & "<br/><br/><br/><br/>" & _ ...
dans la chaine HTMLBody
VB:
.HTMLBody = "<html><p>" & _
                    strbody & "</p><img src=""cid:NamePicture(1).jpg"" width=700 height=800>" & _
                    "<br/><br/><br/><br/>" & _
                    strbody & "</p><img src=""cid:NamePicture(2).jpg"" width=700 height=800></html>"

Feuil1 et Feuil2 sont les CodeNames des onglets.
l'emploi des CodeNames permet de déplacer, renommer les onglets sans avoir à retoucher au code VBA. Voir CodeName.png ci-dessous cerclé de Bleu le CodeName, de Rouge le nom d'Onglet.

Pourrais-tu fournir une liste avec :
Nom d'onglet et CodeName des feuilles envoyées en JPEG et imprimées en PDF ?
Nom d'onglet et CodeName des feuilles envoyées en JPEG uniquement ?

Est je bien compris
1666627040420.png
 

patricktoulon

XLDnaute Barbatruc
Bonsoir
ma proposition
j'ai cru comprendre qu'en fait de l'image il s'agissait de la copie de la plage
je te propose donc ma fonction 2022 createtable2
qui construit la table html sur la base de la plage
ta sub pdf est devenu une fonction et est intégrée a la sub outlook
pour le pdf attaché
 

Pièces jointes

  • TestEnvois.xlsm
    45 KB · Affichages: 14

Discussions similaires

Statistiques des forums

Discussions
313 320
Messages
2 097 137
Membres
106 848
dernier inscrit
toufk