XL 2016 Macro copier coller une feuille sur email outloook

[MONTREAL2020]

Bonjour,

J'ai une macro pour créer un PDF d'une feuille excel et ça marche très bien.

Toutefois, je souhaiterai que la page imprimer PDF soit coller au corp du message à envoyer.

merci

Sub mail()

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 S As Shape

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

Set Sourcewb = ActiveWorkbook

'Copie la feuille active comme nouvelle feuille

ActiveSheet.Copy
Set destwb = ActiveWorkbook

'Désactiver fenêtre de compatibilité
Application.DisplayAlerts = False
'----------------------------------------------------------------------------
'Sauvegarde la nouvelle feuille/L'envoie par mail/La supprime
'----------------------------------------------------------------------------

TempFilePath = Environ$("temp") & "\"
TempFileName = ActiveSheet.Name

Set OutApp = CreateObject("outlook.application")
Set OutMail = OutApp.CreateItem(0)

With destwb
.ExportAsFixedFormat Type:=xlTypePDF, Filename:=TempFilePath & TempFileName & ".pdf", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False ' sauvegarde du fichier au format pdf

On Error Resume Next
With OutMail
.To = "rico.rico@ttt.com"
.CC = "ricorico@gmail.com"
.BCC = ""
.Subject = "Rapport de performance "
.Attachments.Add TempFilePath & TempFileName & ".pdf"
.Body = "Bonjour, blab lalalalalalal "
'.display 'ou alors utiliser
.Send 'pour envoi
End With
On Error GoTo 0
.Close savechanges:=False
End With

'Effacer le fichier envoyé
Kill TempFilePath & TempFileName & ".pdf"

Set OutMail = Nothing
Set OutApp = Nothing

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

End Sub

 

[fanch55]

Bonjour,

Mail Range/Selection in the body of the mail