Envoyer une feuille en fichier PDF par mail automatiquement

Le 24/04/2020 à 00:25

Bonjour,

Je suis débutante en code VBA. J'ai fait plusieurs recherches, mais je n'ai trouvé aucune réponse qui répond entièrement à ce que je recherche.

J'ai un fichier qui contient plusieurs feuilles de travail. Je souhaite convertir une partie d'une seule de ces feuilles en format PDF, puis l'envoyer par courriel Outlook de façon automatique. Je ne souhaite pas arriver dans la boîte de messagerie et devoir envoyer le courriel. Aussi, je ne veux pas enregistrer la feuille de travail en PDF pour la conserver. Elle doit simplement être en pièce jointe dans le courriel.

Le destinataire est toujours le même. Le fichier doit rester ouvert après l'envoi du courriel.

J'ai essayé ce code, mais il envoi le fichier complet dans le courriel, avec un délai de presque 1 heure.

Dim Destinataires(1) As String, Sujet As String
Dim AccuseReception As Boolean

Destinataires(1) = "adresse courriel"

Sujet = "Facture" & " " & "#" & " " & Sheets("Création de facture").Range("l38")
AccuseReception = True

ThisWorkbook.Sheets("Création de facture").Range("a1:l38").Copy
ActiveWorkbook.sendMail Destinataires, Sujet, AccuseReception

Le fichier de travail est trop lourd pour être envoyé, ce qui fait que je vous ai laissé le code complet qui fonctionne très bien à titre de référence.

'BOUTON "Archiver la facture"'
Private Sub CommandButton2_Click()

'Indique que si la case "Nom du client" est vide, envoyer le message de remplir la case pour poursuivre'
If Sheets("Création de facture").Range("f6") = "" Then
    MsgBox ("Veuillez inscrire le nom du client.")
    Exit Sub
End If

'Indique que si la case "Escompte" est vide, envoyer le message de remplir la case pour poursuivre'
If Sheets("Création de facture").Range("h12") = "" Then
    MsgBox ("Veuillez inscrire le % d'escompte.")
    Exit Sub
End If

'Indique que si la case "Total" est vide, envoyer le message de remplir la case pour poursuivre'
If Sheets("Création de facture").Range("l38") = 0 Then
    MsgBox ("Veuillez inscrire la quantité et description des articles vendus.")
    Exit Sub
End If

'Demande à l'utilisateur s'il désire archiver la facture'
    Dim answer As Integer
        answer = MsgBox("Êtes-vous bien certain de vouloir archiver cette facture?", vbYesNo + vbQuestion, "")

'Si l'utilisateur désire archiver...'
If answer = vbYes Then

'Permet d'inscrire des données dans les feuilles protégées'
    Sheets("Création de facture").Unprotect Password:="xxxx"
    Sheets("Historique factures").Protect Password:="xxxx"
    Sheets("Impression de facture").Protect Password:="xxxx"

'Incrémentation de la facture dans l'onglet "Historique factures"'
    ligne = Sheets("Historique factures").Range("b2").End(xlDown).Row + 1
    Sheets("Historique factures").Range("a" & ligne).Value = Sheets("Création de facture").Range("k1").Value
    Sheets("Historique factures").Range("b" & ligne).Value = Sheets("Création de facture").Range("d38").Value
    Sheets("Historique factures").Range("c" & ligne).Value = Sheets("Création de facture").Range("f6").Value
    Sheets("Historique factures").Range("d" & ligne).Value = Sheets("Création de facture").Range("f7").Value
    Sheets("Historique factures").Range("e" & ligne).Value = Sheets("Création de facture").Range("f8").Value
    Sheets("Historique factures").Range("f" & ligne).Value = Sheets("Création de facture").Range("k8").Value
    Sheets("Historique factures").Range("g" & ligne).Value = Sheets("Création de facture").Range("h9").Value
    Sheets("Historique factures").Range("h" & ligne).Value = Sheets("Création de facture").Range("l38").Value

'Copie des données de la feuille "Création de facture" sur la feuille "Impression facture"'
    Sheets("Impression de facture").Range("b13:d36").Value = Sheets("Création de facture").Range("b13:d36").Value
    Sheets("Impression de facture").Range("h12").Value = Sheets("Création de facture").Range("h12").Value
    Sheets("Impression de facture").Range("f6").Value = Sheets("Création de facture").Range("f6").Value
    Sheets("Impression de facture").Range("f7").Value = Sheets("Création de facture").Range("f7").Value
    Sheets("Impression de facture").Range("f8").Value = Sheets("Création de facture").Range("f8").Value
    Sheets("Impression de facture").Range("k8").Value = Sheets("Création de facture").Range("k8").Value
    Sheets("Impression de facture").Range("f9").Value = Sheets("Création de facture").Range("f9").Value
    Sheets("Impression de facture").Range("h9").Value = Sheets("Création de facture").Range("h9").Value
    Sheets("Impression de facture").Range("d38").Value = Sheets("Création de facture").Range("d38").Value
    Sheets("Impression de facture").Range("k1").Value = Sheets("Création de facture").Range("k1").Value

[Surligner]Je souhaite que le code soit insérer ici[/Surligner]
'Commande d'envoi courriel de la feuille PDF "Création de facture"'

'Vide le contenu de la feuille "Création de facture"'
    Sheets("Création de facture").Range("b13:d36").ClearContents
    Sheets("Création de facture").Range("h12:i12").ClearContents
    Sheets("Création de facture").Range("f6:k6").ClearContents

'Numérotation automatique de la nouvelle facture'
    Sheets("Création de facture").Range("d38").Value = Sheets("Création de facture").Range("d38").Value + 1

'Remet la protection sur les feuilles protégées'
    Sheets("Création de facture").Protect Password:="xxxx"
    Sheets("Historique factures").Protect Password:="xxxx"
    Sheets("Impression de facture").Protect Password:="xxxx"

'Informe l'utilisateur de l'endroit où se rendre pour imprimer la facture'
    MsgBox ("Veuillez imprimer la facture dans l'onglet 'Impression de facture'.")

'Enregistre le fichier'
    ActiveWorkbook.Save

'Si l'utilisateur ne souhaite pas archiver...'
Else
    MsgBox ("Veuillez compléter la facture")

End If

End Sub

Je vous remercie énormément à l'avance pour votre aide!

Le 24/04/2020 à 02:05

Bonjour,

à tester,

Sub Mail_Outlook_Sheet_PDF()
'Il faut activer la référence "Microsoft Outlook xx.x Object Library" Avant de lancer cette macro
Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

chemin = "C:\Users\isabelle\Documents\" 'à adapter
fichier = "Monfichier.pdf"  'à adapter

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=chemin & fichier, Quality:= _
    xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
    From:=4, To:=4, OpenAfterPublish:=False

With OutMail
    .To = "destinataire@site.com"
    .CC = ""
    .BCC = ""
    .Subject = "This is the Subject line"
    .Body = "Hello World!"
    .Attachments.Add (chemin & fichier)
    .display
'    .Send
End With

Set OutMail = Nothing
Set OutApp = Nothing
Kill chemin & fichier
End Sub
Le 24/04/2020 à 17:13

Bonjour Isabelle,

J'essaie le code que tu m'as envoyé.

Il y a quelque chose qui cloche.

Peux-tu me pister sur le problème svp?

Je te laisse la section du code qui est surligné en jaune.

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=chemin & fichier, Quality:= _
    xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
    From:=4, To:=4, OpenAfterPublish:=False

Merci!

Le 24/04/2020 à 17:18

Est-ce possible que le problème soit parce que j'ai une commande "ThisWorkbook" spécifique concernant cette feuille qui empêche l'impression de la feuille?

'Empêche l'impression des feuilles identifiées'
Private Sub workbook_BeforePrint(Cancel As Boolean)

'Identifie les feuilles concernées'
Select Case ActiveSheet.Name
    Case "Création de facture", "Historique factures", "Paramètres": Cancel = True
    Case Else: Cancel = False

End Select

'Message pour les feuilles "Historique factures" et "Paramètres"'
Select Case ActiveSheet.Name
    Case "Historique factures", "Paramètres"
    MsgBox ("Vous ne pouvez pas imprimer cette feuille.")

End Select

'Message pour la feuille "Création de facture"'
Select Case ActiveSheet.Name
    Case "Création de facture"
    MsgBox ("Pour imprimer la facture, veuillez appuyer sur le bouton 'Archiver la facture', puis vous rendre sur l'onglet 'Impression de facture'.")

End Select

End Sub
Le 25/04/2020 à 22:55

Bonjour Isabelle,

J'ai trouvé comment contourner la demande de refus d'impression et à faire fonctionner le code que tu m'as envoyé.

C'est exactement ce que je voulais!!

Je me permets cependant de relever ici une correction pour le bénéfice des futurs utilisateurs

Dans le code,

'    .Send

Aurait dû être:

.Send

Sinon, tout le reste est parfait!

Je ne te remercierai jamais assez pour le code que tu m'as envoyé!

Le 26/04/2020 à 17:13
Boulangerie a écrit :

Je me permets cependant de relever ici une correction pour le bénéfice des futurs utilisateurs

re,

ce n'est pas une erreur, mais plutôt un choix entre :

.Display

et

.Send

c'est à dire mettre .send en commentaire et laisser .display pour voir le message avant qu'il soit envoyé,

ou le contraire, mettre .display en commentaire et laisser .send, le message est envoyé sans qu'on le voit.

Le 26/04/2020 à 17:19

Bonjour Boulangerie et bonjour Isabelle,

J'ai suivi vos échanges et j'ai une question pour toi Isabelle.

Pourquoi la valeur 4 à : From:=4, To:=4 ?

Merci pour ta réponse.

Cdt

Le 26/04/2020 à 17:34

Bonjour ddetp88,

dans cette exemple j'ai choisi la page 4 (uniquement)

ça peut être

From:=1, To:=4 pour les 4 première pages

ou

From:=1, To:=1 pour la première page (uniquement)

Le 26/04/2020 à 17:47

Je ne m'étais jamais intéressé au problème, merci pour ta réponse.

Au plaisir

Le 27/04/2020 à 12:26

Merci pour les précisions!

Rechercher des sujets similaires à "envoyer feuille fichier pdf mail automatiquement"