XL 2016 Envoi onglet Excel + onglet pdf par mail Répondre

Maxou69

XLDnaute Nouveau
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 :

VB:
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 :

Code:
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")
 
Solution
Bonjour Maxou69,

il faut modifier le chemin des fichiers. Thisworkbook.Path signifie que ceux-ci sont dans le même dossier. Si ils sont ailleur, il faut remplacer Thisworkbook.Path par (exemple: C:\Toto\Tata\Titi\Classeur xls - C:\Toto\Tata\Tutu\Fichier pdf).

Lone-wolf

XLDnaute Barbatruc
Bonsoir Maxou69

VB:
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

Note: xlsx ne prend pas en charge les macros, j'ai donc mis xls.
 
Dernière édition:

Maxou69

XLDnaute Nouveau
Salut Lone Wolf,

Merci infiniment pour ton code c'est top ! :)

J'ai juste une question
J'ai ajouter mon chemin pour enregistrer les fichiers mais j'ai un soucis sur la ligne suivante :

VB:
 ActiveSheet.SaveAs Filename:=FichXl, FileFormat:=18, CreateBackup:=False

Le message d'erreur est :

- Assurer vous que le dossier spécifié existe
- Assurer vous que le dossier contenant le fichier n'est pas en mode Lecteur Seule
- Assurer que le nom du fichier et le chemin du dossier ne..

Ce qui est bizarre c'est que le code à fonctionner une fois et après il me bloque sur cette ligne :(
 

Lone-wolf

XLDnaute Barbatruc
Bonjour Maxou69,

il faut modifier le chemin des fichiers. Thisworkbook.Path signifie que ceux-ci sont dans le même dossier. Si ils sont ailleur, il faut remplacer Thisworkbook.Path par (exemple: C:\Toto\Tata\Titi\Classeur xls - C:\Toto\Tata\Tutu\Fichier pdf).
 

Maxou69

XLDnaute Nouveau
Hello Lone-wolf

Merci infiniment pour ton aide !

J'ai enfin réussis à créer le code !!
J'ai eu un peu de difficulté car sur ma feuille à convertir en PDF j'ai des formules excel qui reprenne des données d'un autre onglet et je ne pouvais par l'exporter avec les formules

Merci beaucoup !!! :D :D
 

Discussions similaires

Réponses
6
Affichages
268