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

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
Oneida

Oneida

XLDnaute Impliqué
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
M

Mika07

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

kiki29

XLDnaute Barbatruc
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
M

Mika07

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

TooFatBoy

XLDnaute Barbatruc
Mika07 à dit:
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 ».
Cliquez pour agrandir...
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
kiki29

kiki29

XLDnaute Barbatruc
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
    1.png
    19.4 KB · Affichages: 22
  • Code XLD.png
    Code XLD.png
    4.8 KB · Affichages: 20
Dernière édition:
Vote positif 0 Vote négatif
M

Mika07

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

Mika07

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

Discussions similaires

M
  • Question
Microsoft 365 Joindre une copie de 2 feuilles Excel dans outlook
Réponses
0
Affichages
441
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
1 K
Fabrice16ct
F
G
  • Question
XL 2016 Extraire des données d'un pdf et les copier dans excel
2
Réponses
17
Affichages
813
gali2
G
G
  • Résolu(e)
XL 2021 Envoie d'informations sélectionnés par mail
Réponses
3
Affichages
202
TooFatBoy
TooFatBoy
halecs93
  • Question
Microsoft 365 Générer mail via Excel
Réponses
2
Affichages
657
halecs93
halecs93
A
  • Question
Microsoft 365 Génération d'une feuille en Pdf et envoie par outlook
Réponses
5
Affichages
1 K
patricktoulon
patricktoulon
R
  • Résolu(e)
Microsoft 365 Extraction contenu mail outlook vers excel
2
Réponses
18
Affichages
1 K
raf26
R
N
  • Question
XL 2016 Code VBA pour envoi de mail avec pdf en piece jointe
Réponses
4
Affichages
307
Phil69970
Phil69970
A
  • Question
insertion d'une ligne automatique dans un tableau excel.
Réponses
1
Affichages
280
sylvanu
sylvanu
F
  • Question
Microsoft 365 Problème avec VBA ( Résolu)
Réponses
2
Affichages
300
firecarl
F

Membres actuellement en ligne

1 membres et 55 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
315 087
Messages
2 116 084
Membres
112 655
dernier inscrit
fannycordi