Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

XL 2019 Excel - générer .PDF avec envoie mail

Créer une discussion

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
M

Mika07

XLDnaute Nouveau
Bonjour,

J'utilise cette macro depuis longtemps.
Cela fonctionne parfaitement quand le bouton se trouve sur un onglet "Feuil1"
La macro génère un PDF et un mail de l'onglet "Feuil1".

Maintenant j'essaye de mettre mon bouton dans un autre onglet "Feuil4" pour que quand j'appuie dessus le PDF généré soit les "Feuil1 à 3".
Tout en gardant le mail.


Code: 
Sub Saveandsend()
Dim xSht As Worksheet
Dim xFileDlg As FileDialog
Dim xFolder As String
Dim xYesorNo As Integer
Dim xOutlookObj As Object
Dim xEmailObj As Object
Dim xUsedRng As Range

Set xSht = ActiveSheet
Set xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)

If xFileDlg.Show = True Then
   xFolder = xFileDlg.SelectedItems(1)
Else
   MsgBox "You must specify a folder to save the PDF into." & vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Must Specify Destination Folder"
   Exit Sub
End If
xFolder = xFolder + "\" + Range("C6") + ".pdf"

'Check if file already exist
If Len(Dir(xFolder)) > 0 Then
    xYesorNo = MsgBox(xFolder & " already exists." & vbCrLf & vbCrLf & "Do you want to overwrite it?", _
                      vbYesNo + vbQuestion, "File Exists")
    On Error Resume Next
    If xYesorNo = vbYes Then
        Kill xFolder
    Else
        MsgBox "if you don't overwrite the existing PDF, I can't continue." _
                    & vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Exiting Macro"
        Exit Sub
    End If
    If Err.Number <> 0 Then
        MsgBox "Unable to delete existing file.  Please make sure the file is not open or write protected." _
                    & vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Unable to Delete File"
        Exit Sub
    End If
End If

Set xUsedRng = xSht.UsedRange

If Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Then
    'Save as PDF file
    xSht.ExportAsFixedFormat Type:=xlTypePDF, Filename:=xFolder, Quality:=xlQualityStandard

    'Create Outlook email
    Set xOutlookObj = CreateObject("Outlook.Application")
    Set xEmailObj = xOutlookObj.CreateItem(0)
    With xEmailObj
        .display
        .TO = Range("C3")
        .CC = Range("C4")
        .BCC = Range("C5")
        .Subject = Range("C6")
        .HTMLBody = "<FONT size=3>" & Range("C7") & "<br>" _
                    & "<br>" _
                    & Range("C8") & "<br>" _
                    & Range("C9") & "<br>" & .HTMLBody
        .Attachments.Add xFolder

        If DisplayEmail = False Then
            '.Send
        End If
    End With
Else
  MsgBox "The active worksheet cannot be blank"
  Exit Sub
End If
End Sub
 
Dernière édition:
Solution
M
Bonjour,

Merci à vous pour votre aide.

J'ai mis le code sur mon fichier mais cela me met une erreur sur la ligne :
Code: 
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=xFolder, Quality:=xlQualityStandard, OpenAfterPublish:=True

Alors que sur le fichier test ca fonctionne bien.

En cherchant un peu, quand je change le Filename, ca passe mais j'ai une erreur plus loin.

Code: 
Sub Saveandsend()
Dim xSht As Worksheet
Dim xFileDlg As FileDialog
Dim xFolder As String
Dim xYesorNo As Integer
Dim xOutlookObj As Object
Dim xEmailObj As Object
Dim xUsedRng As Range

Set xSht = ActiveSheet
Set xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)

If xFileDlg.Show = True Then
   xFolder = xFileDlg.SelectedItems(1)
Else
   MsgBox...
Trier par date Trier par votes
Bonjour,

Sub enr_feuille_PDF()
'ici plusieur feuille
ThisWorkbook.Sheets(Array("Sheet1", "Sheet2", "Sheet3")).Select
Selection.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:="C:\TestFolder\temp.pdf", _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=True
End Sub
 
Vote positif 0 Vote négatif
Super,

Merci beaucoup.

En remplaçant :
xSht.ExportAsFixedFormat Type:=xlTypePDF, Filename:=xFolder, Quality:=xlQualityStandard
par
ThisWorkbook.Sheets(Array("Sheet1", "Sheet2", "Sheet3")).Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=xFolder, Quality:=xlQualityStandard, OpenAfterPublish:=True

Ca fonctionne nickel 👍

Bonne soirée !
 
Vote positif 0 Vote négatif
Salut, ne pas omettre de désélectionner les feuilles après ActiveSheet.ExportAsFixedFormat via Sheets("Sheet1").Select par exemple , sinon si tu saisis qqch sur l'une d'entre elles cela se trouvera reporté sur toutes les autres ...
 
Vote positif 0 Vote négatif
J’avais essayé avec « Sélection » mais cela m’imprimait 4 feuilles blanches avec un carré noir sur la 1er page.
En mettant cela ça a fonctionné de suite….mais plus maintenant. Je ne comprends pas.
En ayant sauvegardé puis en relançant le fichier, cela me met une erreur sur la ligne. Même en mettant « sélection ».
 
Vote positif 0 Vote négatif
Du coup, si tu essayes comme je le disais plus haut, sans le Select, tu n'auras peut-être plus ce problème, et ça répondra à ma question. 😉
 
Dernière édition:
Vote positif 0 Vote négatif
Salut, tout simplement
VB: 
ActiveSheet.ExportAsFixedFormat ....
pour remplacer Selection.ExportAsFixedFormat ......

voir Impression de certaines Feuilles d'un classeur via un tableau dans un seul Pdf résultant
en bas du tout 1er post datant de 2007 de Liste Contributions PDF

@Mika07 : Balise ton code !
 

Pièces jointes

  • 1.png
    19.4 KB · Affichages: 39
  • Code XLD.png
    4.8 KB · Affichages: 31
Dernière édition:
Vote positif 0 Vote négatif
Bonjour,

Merci à vous pour votre aide.

J'ai mis le code sur mon fichier mais cela me met une erreur sur la ligne :
Code: 
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=xFolder, Quality:=xlQualityStandard, OpenAfterPublish:=True

Alors que sur le fichier test ca fonctionne bien.

En cherchant un peu, quand je change le Filename, ca passe mais j'ai une erreur plus loin.

Code: 
Sub Saveandsend()
Dim xSht As Worksheet
Dim xFileDlg As FileDialog
Dim xFolder As String
Dim xYesorNo As Integer
Dim xOutlookObj As Object
Dim xEmailObj As Object
Dim xUsedRng As Range

Set xSht = ActiveSheet
Set xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)

If xFileDlg.Show = True Then
   xFolder = xFileDlg.SelectedItems(1)
Else
   MsgBox "You must specify a folder to save the PDF into." & vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Must Specify Destination Folder"
   Exit Sub
End If
xFolder = xFolder + "\" + Range("C6") + ".pdf"

'Check if file already exist
If Len(Dir(xFolder)) > 0 Then
    xYesorNo = MsgBox(xFolder & " already exists." & vbCrLf & vbCrLf & "Do you want to overwrite it?", _
                      vbYesNo + vbQuestion, "File Exists")
    On Error Resume Next
    If xYesorNo = vbYes Then
        Kill xFolder
    Else
        MsgBox "if you don't overwrite the existing PDF, I can't continue." _
                    & vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Exiting Macro"
        Exit Sub
    End If
    If Err.Number <> 0 Then
        MsgBox "Unable to delete existing file.  Please make sure the file is not open or write protected." _
                    & vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Unable to Delete File"
        Exit Sub
    End If
End If


Set xUsedRng = xSht.UsedRange

If Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Then
    'Save as PDF file
    ThisWorkbook.Sheets(Array("Page de présentation", "Renseignements", "Etat livraison", "Etat installation")).Select
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=xFolder, Quality:=xlQualityStandard, OpenAfterPublish:=True
    
    'Create Outlook email
    Set xOutlookObj = CreateObject("Outlook.Application")
    Set xEmailObj = xOutlookObj.CreateItem(0)
    With xEmailObj
        .display
        .TO = Range("C5")
        .CC = Range("C6")
        .BCC = Range("C7")
        .Subject = Range("C8")
        .HTMLBody = "<FONT size=3>" & Range("C9") & "<br>" _
                    & "<br>" _
                    & Range("C10") & "<br>" _
                    & Range("11") & "<br>" & .HTMLBody
        .Attachments.Add xFolder
                
        If DisplayEmail = False Then
            '.Send
        End If
    End With
Else
  MsgBox "The active worksheet cannot be blank"
  Exit Sub
End If
End Sub
 
Vote positif 0 Vote négatif
Solution
J'ai trouvé mon erreur, désolé pour le dérangement !

J'avais oublié de remettre la bonne cellule pour le titre du PDF. Cela me générait aucun PDF car la casse était vide.

Code: 
xFolder = xFolder + "\" + Range("C6") + ".pdf"

Je clôt le sujet.

Merci beaucoup, bonne journée ! 🙂
 
Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

T
  • Résolu(e)
Microsoft 365 VBA Exporter une sélection de plages nommées au format PDF
Réponses
12
Affichages
938
tnion
T
N
  • Résolu(e)
Microsoft 365 Macro enregistrement automatique pdf
2
Réponses
18
Affichages
673
Nounours4173
N
M
  • Question Question
Microsoft 365 Joindre une copie de 2 feuilles Excel dans outlook
Réponses
0
Affichages
616
Mika07
M
F
  • Résolu(e)
XL 2019 Enregistrer sous la feuille active dans répertoire du fichier père en vba
2
Réponses
23
Affichages
2 K
Fabrice16ct
F
G
  • Question Question
XL 2016 Extraire des données d'un pdf et les copier dans excel
2
Réponses
19
Affichages
2 K
kiki29
L
  • Question Question
Microsoft 365 Erreur automation 440 sur code VBA
Réponses
1
Affichages
300
job75
X
  • Question Question
Microsoft 365 compte à rebours avec application.OnTime (Résolu)
Réponses
9
Affichages
191
xabino
X
S
  • Question Question
Microsoft 365 code vba pour chaine de caractère
Réponses
4
Affichages
390
vgendron
  • Question Question
Microsoft 365 VBA : copier les adresses
Réponses
7
Affichages
658
VBA_dev_Anne_Marie
F
  • Question Question
XL 2021 probleme dans la macro
Réponses
4
Affichages
552
kiki29
G
  • Résolu(e)
XL 2021 Envoie d'informations sélectionnés par mail
Réponses
3
Affichages
360
TooFatBoy
T
  • Résolu(e)
XL 2019 Filtrer certains champs au démarrage avec vba
2
Réponses
15
Affichages
1 K
telemarrk
T
A
  • Question Question
XL 2019 Copie d'une valeur dans la cellule à côté d'une valeur trouvé
Réponses
1
Affichages
445
sylvanu
N
  • Question Question
XL 2016 Code VBA pour envoi de mail avec pdf en piece jointe
Réponses
4
Affichages
711
Phil69970
Capturer et imprimer ou exporter en pdf un userform
Réponses
4
Affichages
380
PHV62
P
  • Question Question
Microsoft 365 Générer mail via Excel
Réponses
2
Affichages
921
halecs93
A
  • Question Question
XL 2010 Filtrer un Combobox en VBA excel
2 3
Réponses
43
Affichages
2 K
Dranreb
  • Question Question
XL 2016 XLS - Comment déterminer les zones présentent au niveau d'une cellule ?
Réponses
2
Affichages
602
Lu76Fer
G
  • Question Question
XL 2021 Macro pour changer les titres de fichier d'archive
Réponses
3
Affichages
596
fanch55
A
  • Question Question
Microsoft 365 Génération d'une feuille en Pdf et envoie par outlook
Réponses
5
Affichages
1 K
patricktoulon
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…