Stephane.Blandino
XLDnaute Nouveau
Bonjour à tous,
J'espère que vous allez bien.
Je n'arrive pas à copier une feuille de classeur en tant qu'image pour qu'elle soit par la suite envoyée par email (outlook).
J'ai fait un code mais je n'arrive pas à l'inclure l'image dans le corps du mail.
Je ne souhaite pas de mettre en fichier joint un pdf mais uniquement une copie image de Excel dans le corps du texte Outlook.
Est ce que c'est faisable ?
Merci de votre aide précieuse car je suis bloqué.
Cdt
Stéphane
J'espère que vous allez bien.
Je n'arrive pas à copier une feuille de classeur en tant qu'image pour qu'elle soit par la suite envoyée par email (outlook).
J'ai fait un code mais je n'arrive pas à l'inclure l'image dans le corps du mail.
Je ne souhaite pas de mettre en fichier joint un pdf mais uniquement une copie image de Excel dans le corps du texte Outlook.
Est ce que c'est faisable ?
Merci de votre aide précieuse car je suis bloqué.
Cdt
Stéphane
VB:
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim Sourcewb As Workbook
Dim destwb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim OutApp As Object
Dim OutMail As Object
Dim xMailBody As String
Dim S As Shape
Dim sNomFic As String, sRep As String, WshShell As Object
Dim Superviseur As String
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
' Créer une instance Windows Script pour retrouver le chemin du bureau
Set WshShell = CreateObject("WScript.Shell")
sRep = WshShell.SpecialFolders("Desktop")
Set WshShell = Nothing
' Définit le nom du fichier à enregistrer
sNomFic = ThisWorkbook.Sheets("Datas").Range("H2").Value & ".pdf"
Superviseur = ThisWorkbook.Sheets("Synthèse OPS").Range("B5").Value
' Enregistrer la feuille en PDF
Range("A1:H29").Select
Selection.ExportAsFixedFormat Type:=xlTypePDF, Filename:=sRep & "\" & sNomFic, Quality:= _
xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=False
xMailBody = "Bonjour à tous," & "<br>" & "<br>" & _
"Ci-joint le compte rendu de vacation de ce jour." & "<br>" & "<br>" & _
"Bien cordialement," & "<br>"
Set OutApp = CreateObject("outlook.application")
Set OutMail = OutApp.CreateItem(0)
' une idee pour que ca marche mais cest pas un fichier image et il y a des bugs affichage.
' With ActiveSheet.MailEnvelope
' .Introduction = "Bonjour à tous, voici le compte rendu de vacation de ce jour : "
' .Item.To = "xxx"
' .Item.attachments.Add (sRep & "\" & sNomFic)
' .Item.Subject = ThisWorkbook.Sheets("Datas").Range("H2").Value
' .Item.Send
' End With
With OutMail
.To = "<<< Saisir les destinataires >>>"
.attachments.Add (sRep & "\" & sNomFic)
.Subject = ThisWorkbook.Sheets("Datas").Range("H2").Value
.HTMLBody = xMailBody
.Display
End With
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
Kill (sRep & "\" & sNomFic)