Envoi onglet Excel + onglet pdf par mail

Bonjour,

Je recherche à envoyer par mail via une macro, deux onglets d'un fichier excel.

Le 1er onglet sous format excel, et le deuxième onglet sous format PDF

J'ai trouvé les codes me permettant d'envoyer un mail sous format excel, avec les adresses mail a insérer, le message, etc..

J'ai également trouvé le code me permettant de convertir un fichier excel en pdf.

Là où je suis bloquer, c'est comment puis je cumuler ces deux codes afin d'envoyer dans un seul mail, mes deux onglets ? Le premier en Excel et le second en pdf ?

Est ce possible ? Ou je m'aventure sur un code non réalisable ?

Merci par avance de votre aide ! :)

Code conversion PDF :

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

Code envoi par mail :

Sub Mail_Sheet()

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

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

Set Sourcewb = ActiveWorkbook

'Copy the ActiveSheet to a new workbook
Sheets("Feuil1").Copy
Set Destwb = ActiveWorkbook

'Determine the Excel version and file extension/format
With Destwb
If Val(Application.Version) < 12 Then
'You use Excel 97-2003
FileExtStr = ".xls": FileFormatNum = -4143
Else
'You use Excel 2007-2016
Select Case Sourcewb.FileFormat
Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
Case 52:
If .HasVBProject Then
FileExtStr = ".xlsm": FileFormatNum = 52
Else
FileExtStr = ".xlsx": FileFormatNum = 51
End If
Case 56: FileExtStr = ".xls": FileFormatNum = 56
Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
End Select
End If
End With

' 'Change all cells in the worksheet to values if you want
With Destwb.Sheets(1).UsedRange
.Cells.Copy
.Cells.PasteSpecial xlPasteValues
.Cells(1).Select
End With
Application.CutCopyMode = False

'Save the new workbook/Mail it/Delete it
TempFilePath = Environ$("temp") & "\"
TempFileName = "Feuil1 " & Range("b7") & " " & Range("d7")

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

With Destwb
.SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
On Error Resume Next
With OutMail
.to = "xxx@xxx.xx"
.CC = "xxx@xxx.xx"
.Subject = Range("d16") & "-" & Range("b7") & " " & Range("d7") 
.Body = "blablablablabla"
.Attachments.Add Destwb.FullName
'You can add other files also like this
'.Attachments.Add ("C:\test.txt")
.Display
End With
On Error GoTo 0
.Close savechanges:=False
End With

'Delete the file you have send
Kill TempFilePath & TempFileName & FileExtStr

Set OutMail = Nothing
Set OutApp = Nothing

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

Bonjour,

Pour ajouter une pièce jointe, ce sont ces lignes :

.Attachments.Add Destwb.FullName
.Attachments.Add CheminPDF 'ICI POUR AJOUTER VOTRE PDF
'You can add other files also like this

Cordialement,

Bonjour 3GB,

Merci pour ton commentaire :)

J'ai réussis à faire ce que je voulais avec le code :

Sub Envois_Fichier()
    Dim FichXl As String, FichPdf As String, i As Integer
    Dim OutApp As Object, OutMail

    Application.ScreenUpdating = False

    Sheets(1).Activate
    ActiveSheet.Copy
    FichXl = ThisWorkbook.Path & "\" & "Cal-2020.xls"  'chemin et nom du classeur à modifier

    ActiveSheet.SaveAs Filename:=FichXl, FileFormat:=18, CreateBackup:=False
    ActiveWorkbook.Close True

    Sheets(2).Activate
    ActiveSheet.Copy
    FichPdf = ThisWorkbook.Path & "\" & "Jours Feriés" & ".pdf"    'Idem pour le PDF

    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=FichPdf, Quality:=xlQualityStandard, _
    IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False

    For i = 1 To 20
        If ActiveWorkbook.Name = "Classeur" & i Then ActiveWorkbook.Close False
    Next i

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

    'À modifier en conséquence
    With OutMail
       'envois à: xxxx
       'texte message: xxxxx xxxxx
       'eccetera, eccetera
        .Attachments.Add FichXl
        .Attachments.Add FichPdf
        .Display
       '.Send  => pour envois direct
    End With

End Sub

Remplacer seulement les

ThisWorkbook.Path

Par le chemin d'accès où enregistrer les fichiers et c'est tout bon :)