Microsoft 365 Macro pour Copier une feuille Excel en tant qu'image dans outlook

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

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)
 

fanch55

XLDnaute Accro

Stephane.Blandino

XLDnaute Nouveau
Bonjour,
Bonjour Fanch,

Merci pour le lien.
C'est ce que je souhaite a peu près mais malheureusement j'ai un message d'erreur quand je l'applique à ma macro :
1630651657306.png

Aurais tu une solution stp ?

Merci d'avance,
Stéphane
 

Discussions similaires

Réponses
2
Affichages
320
Réponses
16
Affichages
389

Statistiques des forums

Discussions
292 981
Messages
1 927 673
Membres
183 584
dernier inscrit
thibault22400