Microsoft 365 Génération d'une feuille en Pdf et envoie par outlook

Créer une discussion
Répondre

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
A

Adrien.dub

XLDnaute Nouveau
Bonjour,

N'ayant pas les connaissance pour la modification d'un code en fonction de mes besoins, j'aimerais un coups de mains pour m'aiguiller sur les modification à apporter.
Je souhaite faire l'extraction d'une feuille active par pression d'un bouton sur la dite feuille pour en générer un Pdf et ensuite envoyer le pdf par mail en fonction des email mis dans la feuille paramètre.
Je bloque actuellement sur la façon de procéder pour nommer mon fichier en fonction de plusieurs cellule bien spécifique qui sont dans l'ordre ("D2"), ("C5") et ("E5").

Voici mon code actuel ainsi que le fichier type.

VB: 
Sub savepdfemail()
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 + "\" + xSht.Name + ".pdf"

'Vérifier si le fichier existe déjà et demande de suppression
If Len(Dir(xFolder)) > 0 Then
    xYesorNo = MsgBox(xFolder & " existe déjà." & vbCrLf & vbCrLf & "Voulez-vous écraser le fichier précédent", _
                      vbYesNo + vbQuestion, "Fichier existant")
    On Error Resume Next
    If xYesorNo = vbYes Then
        Kill xFolder
    Else
        MsgBox "Vous ne pourrez continuer si vous n'acceptez pas" _
                    & vbCrLf & vbCrLf & "Appuyer sur Ok pour quitter.", vbCritical, "Annuler"
        Exit Sub
    End If
    If Err.Number <> 0 Then
        MsgBox "Impossible d'écraser le fichier, merci de vérifier si celui-ci n'est pas ouvert" _
                    & vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Impossible de supprimer le fichier"
        Exit Sub
    End If
End If

Set xUsedRng = xSht.UsedRange
If Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Then
    'Sauvegarde sous format PDF
    xSht.ExportAsFixedFormat Type:=xlTypePDF, Filename:=xFolder, Quality:=xlQualityStandard
    
    'Création du mail outlook
    Set xOutlookObj = CreateObject("Outlook.Application")
    Set xEmailObj = xOutlookObj.CreateItem(0)
    Set emailTO = Worksheets("parametre").Range("C8")
    Set emailCC = Worksheets("parametre").Range("C9")
    Set emailCC1 = Worksheets("parametre").Range("C10")
    Set emailCC2 = Worksheets("parametre").Range("C11")
    Set emailCC3 = Worksheets("parametre").Range("C12")
    Set emailCC4 = Worksheets("parametre").Range("C13")
    Set emailCC5 = Worksheets("parametre").Range("C14")
    With xEmailObj
        .Display
        .To = emailTO
        .CC = emailCC + "; " + emailCC1 + "; " + emailCC2 + "; " + emailCC3 + "; " + emailCC4 + "; " + emailCC5
        .Subject = xSht.Name + ".pdf"
        .Attachments.Add xFolder
        If DisplayEmail = False Then
            
        End If
    End With
Else
  MsgBox "La feuille active ne peux être vierge"
  Exit Sub
End If
End Sub
 

Pièces jointes

Trier par date Trier par votes
Voir via Liste Contributions PDF

pour l'envoi mail voir CDO
sans oublier RdB
Pourquoi utiliser le code CDO au lieu de l'automatisation Outlook ou SendMail dans VBA.

1 : Peu importe le programme de messagerie que vous utilisez (il utilise uniquement le serveur SMTP).
2 : Peu importe la version d'Office que vous utilisez (97…2016)
3 : Vous pouvez envoyer une plage/feuille dans le corps du courrier (certains programmes de messagerie ne peuvent pas le faire)
4: Vous pouvez envoyer n'importe quel fichier que vous aimez (fichiers Word, PDF, PowerPoint, TXT,….)
5 : Aucun avertissement de sécurité, vraiment génial si vous envoyez beaucoup de courrier en boucle.
 
Dernière édition:
Vote positif 0 Vote négatif
Adrien.dub à dit:
Bonjour,

N'ayant pas les connaissance pour la modification d'un code en fonction de mes besoins, j'aimerais un coups de mains pour m'aiguiller sur les modification à apporter.
Je souhaite faire l'extraction d'une feuille active par pression d'un bouton sur la dite feuille pour en générer un Pdf et ensuite envoyer le pdf par mail en fonction des email mis dans la feuille paramètre.
Je bloque actuellement sur la façon de procéder pour nommer mon fichier en fonction de plusieurs cellule bien spécifique qui sont dans l'ordre ("D2"), ("C5") et ("E5").

Voici mon code actuel ainsi que le fichier type.

VB: 
Sub savepdfemail()
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 + "\" + xSht.Name + ".pdf"

'Vérifier si le fichier existe déjà et demande de suppression
If Len(Dir(xFolder)) > 0 Then
    xYesorNo = MsgBox(xFolder & " existe déjà." & vbCrLf & vbCrLf & "Voulez-vous écraser le fichier précédent", _
                      vbYesNo + vbQuestion, "Fichier existant")
    On Error Resume Next
    If xYesorNo = vbYes Then
        Kill xFolder
    Else
        MsgBox "Vous ne pourrez continuer si vous n'acceptez pas" _
                    & vbCrLf & vbCrLf & "Appuyer sur Ok pour quitter.", vbCritical, "Annuler"
        Exit Sub
    End If
    If Err.Number <> 0 Then
        MsgBox "Impossible d'écraser le fichier, merci de vérifier si celui-ci n'est pas ouvert" _
                    & vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Impossible de supprimer le fichier"
        Exit Sub
    End If
End If

Set xUsedRng = xSht.UsedRange
If Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Then
    'Sauvegarde sous format PDF
    xSht.ExportAsFixedFormat Type:=xlTypePDF, Filename:=xFolder, Quality:=xlQualityStandard
   
    'Création du mail outlook
    Set xOutlookObj = CreateObject("Outlook.Application")
    Set xEmailObj = xOutlookObj.CreateItem(0)
    Set emailTO = Worksheets("parametre").Range("C8")
    Set emailCC = Worksheets("parametre").Range("C9")
    Set emailCC1 = Worksheets("parametre").Range("C10")
    Set emailCC2 = Worksheets("parametre").Range("C11")
    Set emailCC3 = Worksheets("parametre").Range("C12")
    Set emailCC4 = Worksheets("parametre").Range("C13")
    Set emailCC5 = Worksheets("parametre").Range("C14")
    With xEmailObj
        .Display
        .To = emailTO
        .CC = emailCC + "; " + emailCC1 + "; " + emailCC2 + "; " + emailCC3 + "; " + emailCC4 + "; " + emailCC5
        .Subject = xSht.Name + ".pdf"
        .Attachments.Add xFolder
        If DisplayEmail = False Then
           
        End If
    End With
Else
  MsgBox "La feuille active ne peux être vierge"
  Exit Sub
End If
End Sub
Cliquez pour agrandir...
Ajouter :
Dim xOutlookObjAs As Object
 
Vote positif 0 Vote négatif
Bonjour
j'ai revu en totalité ton code
j'ai fait simple
la boite de dialogue c'est la "enregistrer sous " avec le nom de fichier prédéterminé
quand tu concactaine du texte (du string) evite les "+" utilise plutot "&"
je t'ai ajouté un petit message
je n'ai pas compris pourquoi en anglais mais bon j'ai continué sur la lancée
voilà
VB: 
Sub savepdfemail()
    Dim xSht As Worksheet, Nom$, FilePDF, Rep As VbMsgBoxResult, OK As Boolean, xOutlookObj As Object, xEmailObj As Object, DisplayEmail As Boolean

    Set xSht = ActiveSheet
    Nom = xSht.[D2] & " " & xSht.[c5] & " " & Format(xSht.[E5], "dd-mm-yyyy")
    OK = True
    DisplayEmail = True

    FilePDF = Application.GetSaveAsFilename(InitialFileName:=Nom, filefilter:="Pdf Files (*.pdf), *.pdf", Title:="ENREGISTREMENT DE LA FEUILLE EN PDF")
    'dialog to save filepdf
    If FilePDF = False Then
        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
    'if you dont press "Annuler"  then ok is true
    If Dir(FilePDF) <> "" Then
        Rep = MsgBox("This file exists, do you want to overwrite the existing one?", vbYesNo + vbExclamation, "Alert existing file")
        OK = Rep = vbYes
    End If
    'if ok is true then save  the pdffile with then variable name(nom)
    ' and open outlook
    If OK Then
        xSht.ExportAsFixedFormat Type:=xlTypePDF, Filename:=FilePDF, Quality:=xlQualityStandard

        'Création du mail outlook
        Set xOutlookObj = CreateObject("Outlook.Application")
        Set xEmailObj = xOutlookObj.CreateItem(0)
        emailTO = Worksheets("parametre").Range("C8").Text
        emailCC = Worksheets("parametre").Range("C9").Text
        emailCC1 = Worksheets("parametre").Range("C10").Text
        emailCC2 = Worksheets("parametre").Range("C11").Text
        emailCC3 = Worksheets("parametre").Range("C12").Text
        emailCC4 = Worksheets("parametre").Range("C13").Text
        emailCC5 = Worksheets("parametre").Range("C14").Text
        With xEmailObj

            .To = emailTO
            .CC = emailCC + "; " + emailCC1 & "; " & emailCC2 & "; " & emailCC3 & "; " & emailCC4 & "; " & emailCC5
            .Subject = Nom

            .Attachments.Add FilePDF

            .body = "Hello, please find attached the [[" & xSht.[D2] & "]] for the night of" & xSht.[E5] & vbCrLf & _
                    "wishing you good reception"


            If DisplayEmail Then
                .Display
               'you cant see the outlook application
                Else
                '.send
            End If
        End With
    End If
End Sub
@+
 
Vote positif 0 Vote négatif
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

pascal21
  • Question Question
XL 2019 envoi pdf d'une feuille par gmail et non pas par outlook
Réponses
7
Affichages
309
pascal21
pascal21
M
  • Résolu(e)
XL 2019 Excel - générer .PDF avec envoie mail
Réponses
12
Affichages
2 K
Mika07
M
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
kiki29
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
patricktoulon
Capturer et imprimer ou exporter en pdf un userform
Réponses
4
Affichages
381
PHV62
P
S
  • Question Question
XL 2013 enregistrer une feuille excel converti en pdf dans un répertoire selon la valeur d'une cellule
Réponses
5
Affichages
525
Phil69970
Phil69970
oguruma
EXCEL :: Les Tableaux Structurés :: Une classe VBA - V1.05 - Evolutions majeures exports CSV, XML, XML UTF-8, JSON, HTML, PDF, JPG, JPEG, BMP, EXCEL
Réponses
10
Affichages
887
oguruma
oguruma
E
  • Question Question
Microsoft 365 GetFolder et Sharepoint
Réponses
3
Affichages
1 K
eric72
E
Nicolas JACQUIN
  • Question Question
XL 2021 Exportation feuille msgbox yes no avec module Thisworkbook
2
Réponses
21
Affichages
2 K
Nicolas JACQUIN
Nicolas JACQUIN
P
  • Question Question
Outlook Outlook imprimer mail et PJ en PDF
Réponses
2
Affichages
1 K
paulng
P
AugusteP
  • Question Question
XL 2021 comment convertir et enregistrer en pdf tout en conservant la date d'une textbox vba
Réponses
2
Affichages
579
AugusteP
AugusteP
B
  • Question Question
Microsoft 365 Envoi pièce jointe html avec Outlook en VBA
Réponses
5
Affichages
1 K
bennp
B
M
  • Question Question
Microsoft 365 VBA - Extraire tous les emails d'une cellule et les coller dans une autre feuille
Réponses
4
Affichages
877
mimich_88
M
N
  • Question Question
Microsoft 365 donner a ma feuille le nom de l'onglet avant envoi par mails
Réponses
2
Affichages
973
Nabster
N
M
  • Question Question
XL 2013 VBA-Envoyer par email "Plage de cellules collée dans un nouveau classeur en gardant formules de certaines cellules
Réponses
2
Affichages
1 K
MONTREAL2020
M
S
  • Question Question
Microsoft 365 Ajout d'une en-tete et pied de page via macro
Réponses
4
Affichages
1 K
saggigo
S
P
  • Résolu(e)
XL 2019 Macro qui enregistre en PDF à personnaliser
Réponses
10
Affichages
2 K
pat66
P
S
  • Question Question
XL 2013 Convertir classeur en PDF, crypter avec mot de passe et envoyer via Outlook
Réponses
2
Affichages
2 K
Saliou MBALO
S
gothc
  • Question Question
XL 2019 envoyer un onglet par email en format pdf
Réponses
4
Affichages
1 K
gothc
gothc
Retour