Sub sendMail()
Dim NomImage$, NomPdf, xOutApp As Object, xOutMail As Object, xHTMLBody As String, plage As Range
Dim Destinataire$, CC$, Titre$, paragraph1$, paragraph2$
'nom des fichiers necessaires
NomImage = ThisWorkbook.Path & "\imgTemp.gif": If Dir(NomImage) <> "" Then Kill (NomImage) ' ne pas toucher ça
NomPdf = ThisWorkbook.Path & "\pdfTemp.pdf": If Dir(NomPdf) <> "" Then Kill (NomPdf) ' adapter le chemin du fichier pdf
Set plage = Feuil1.[A1:c10] ' plage à envoyer dans le corps du mail
'------------------------------
'exportation des fichiers temporaires
'création du pdf avec la plage
plage.ExportAsFixedFormat Type:=xlTypePDF, Filename:=NomPdf, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
'creation de la capture de la plage en image
img = ExportRangeInImage(plage, NomImage)
If img = "" Then MsgBox "la copie de la plage en image n'a pas pu etre effectué": Exit Sub
'----------------------------
'élements du mail
Titre = "test de mail outlook VBA" 'titre du message
Destinataire = "toto@gmail.com" 'destinataire(s) du message( si plusieurs séparer les par une virgule)
CC = "" ' accusé reception
'texte que tu veux avantla plage dans le mail
paragraph1 = "Bonjour Mr le directeur " & vbCrLf & "veuillez trouver ci joint le tableau des ventes de concombres"
paragraph1 = paragraph1 & vbCrLf & " il resume les ventes du mois "
'texte que tu veux apres la plage dans le mail
paragraph2 = " vous souhaitant bonne réception" & vbCrLf & "restant a votre disposition pour tout renseignement"
paragraph2 = paragraph2 & vbCrLf & " votre dévoué serviteur <font face=algerian color=red>le Concombre masqué</font>"
'-----------------------------
' creation du mail outlook
Set xOutApp = CreateObject("outlook.application")
Set xOutMail = xOutApp.CreateItem(olMailItem)
'création du code en html avec les éléments
xHTMLBody = Replace(paragraph1, vbCrLf, "<br>") & "<br><br>" & _
"<center><img src='imgTemp.gif'></center><br><br>" & _
Replace(paragraph2, vbCrLf, "<br>")
'application dans outlook
With xOutMail
.Subject = Titre 'titre du message
.HTMLBody = xHTMLBody 'corps du mail avec insertion de la plage en image entre les deux paragraph
.Attachments.Add NomPdf ' on attache le pdf
.Attachments.Add NomImage ', olByValue, 0 ' on attache l'image de la plage
.To = Destinataire 'destinataire
.CC = CC ' accusé
.display ' soit on affiche l'application outlook
'.send ' soit on envoie direct
End With
'on peut supprimer le pdf temporaire et l'image temporaire de la plage
' If Dir(NomImage) <> "" Then Kill NomImage' à débloquer si mode ".send"
'If Dir(NomPdf) <> "" Then Kill NomPdf' à débloquer si mode ".send"
End Sub
Function ExportRangeInImage(plage As Range, CheminX As String)
'export plage en gif patricktoulon sur exceldownloads
Dim chart1 As Object
If Dir(CheminX) <> "" Then Kill CheminX
With CreateObject("htmlfile").parentwindow.clipboardData.clearData("Text"): End With 'on vide le clipboard entre chaque copie pour tester vraiment le available
plage.CopyPicture
Set chart1 = plage.Parent.ChartObjects.Add(0, 0, 0, 0).Chart
With chart1
With .Parent
.Width = plage.Width: .Height = plage.Height: .Left = plage.Width + 20:
Do: .Chart.Paste: DoEvents: Loop While .Chart.Pictures.Count = 0
.Chart.Export CheminX, "gif"
End With
End With
chart1.Parent.Delete
ExportRangeInImage = Dir(CheminX)
End Function
