Export facture en PDF

Question

Bonjour, à vous

Je cherche à Exporter mes factures Excel en PDF en créant un dossier en cliquant sur un bouton Exporter pour éviter de faire les manipulations.

Le nom du fichier exporter se concatène avec les cellules E5 et L1 (num facture + client)

Pouvez me faire part, pourquoi le code ci-dessous ne fonctionne pas !! Le fichier se trouve dans un répertoire "Finance" sur onedrive et normalement je devrais retrouver Finance/factures Pdf.

Merci d'avance

 


Sub EXPORT_PDF()

Dim Dossier
Dim Chemin As String
Dim ws As Worksheet
Set ws = ActiveSheet
If MsgBox(" Voulez vous exporter la facture en PDF ", vbYesNo + vbQuestion, "Confirmation….. ! ") = vbYes Then

On Error Resume Next
Dossier = Application.InputBox("Insérer nom du dossier", "Création du dossier", "Factures PDF ")
Chemin = ThisWorkbook.Path & " / " & Dossier & " : "


If Dossier = True Then
GetAttr (Chemin) And vbDirectory
Else
MkDir (Chemin)
End If
ws.ExportAsFixedFormat xlTypePDF, Chemin & Range("E5").Value & " _ " & Range("L1").Value, xqualitystandard, True, False, 1, 1, False
End If
End Sub



Windows / Edge 142.0.0.0

JCB40 · Answer

Bonjour

A tester

Sub EXPORT_PDF()
    Dim Dossier As String
    Dim Chemin As String
    Dim ws As Worksheet
    Set ws = ActiveSheet

If MsgBox("Voulez-vous exporter la facture en PDF ?", vbYesNo + vbQuestion, "Confirmation….. !") = vbYes Then
        On Error Resume Next
        Dossier = Application.InputBox("Insérer nom du dossier", "Création du dossier", "Factures PDF")

' Assurez-vous que le chemin est correct
        Chemin = ThisWorkbook.Path & "\" & Dossier & "\"

' Vérifiez si le dossier existe, sinon créez-le
        If Dir(Chemin, vbDirectory) = "" Then
            MkDir Chemin
        End If

' Exporter en PDF
        ws.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Chemin & Range("E5").Value & " _ " & Range("L1").Value & ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, From:=1, To:=1, OpenAfterPublish:=False
    End If
End Sub

Crdlt

danielc0 · Answer

Bonjour,

"ne fonctionne pas"

Il ne donne pas le résultat escompté, ou il provoque une erreur ? Dans  ce dernier cas, laquelle et sur quelle ligne ?

Daniel

danielc0 · Answer

Le code passe sans erreur pour moi. Peut-être :

Chemin = ThisWorkbook.Path & " \ " & Dossier & " : \"

xavier62000 · Answer

Bonjour Daniel

Le code de JCB40 fonctionne, La facture se créer en PDF dans un répertoire dejà créer. Mais perso, je préfère créer le répertoire avec l'Input box. Du moins c'est ce que je croyais !!

Sub EXPORT1_PDF()

Dim Dossier As String
Dim Chemin As String
Dim ws As Worksheet
Set ws = ActiveSheet
If MsgBox("Voulez-vous exporter la facture en PDF ?", vbYesNo + vbQuestion, "Confirmation….. !") = vbYes Then
On Error Resume Next
Dossier = Application.InputBox("Insérer nom du dossier", "Création du dossier", "Factures PDF")
Chemin = ThisWorkbook.Path & "\" & Dossier & "\"
If Dir(Chemin, vbDirectory) = "" Then
MkDir Chemin
End If
ws.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Chemin & Range("E5").Value & " _ " & Range("L1").Value & ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, From:=1, To:=1, OpenAfterPublish:=False
End If
End Sub

danielc0 · Answer

Teste comme ça :

Sub EXPORT_PDF()
  Dim Dossier
  Dim Chemin As String
  Dim ws As Worksheet
  Set ws = ActiveSheet
  If MsgBox(" Voulez vous exporter la facture en PDF ", vbYesNo + vbQuestion, "Confirmation….. ! ") = vbYes Then
    On Error Resume Next
        Dossier = Application.InputBox("Insérer nom du dossier", "Création du dossier", "Factures PDF ")
    Chemin = ThisWorkbook.Path & " \ " & Dossier & " : \"
    Var = ""
    Var = Dir(Chemin, vbDirectory)
    If Err.Number <> 0 Then
      Err.Clear
      MkDir Dossier
    End If
      ws.ExportAsFixedFormat xlTypePDF, Chemin & Range("E5").Value & " _ " & Range("L1").Value, _
      xqualitystandard, True, False, 1, 1, False
  End If
End Sub

Daniel

xavier62000 · Answer

Désolé, le répertoire ne se créé pas ainsi que la facture en Pdf

xavier62000 · Answer

Après que le fichier PDF est généré, je cherche à envoyer par mail la facture avec le code ci-dessous.

Je n'arrive pas à attacher ma facture qui vient d'être généré

sub mail

Dim mail as CDO.Message
Set Mail = New CDO.Message
Mail.configuration.fields.Item(« http://schemas.microsoft.com/cdo/configuration/smtpusessl »)=True
Mail.configuration.fields.Item(« http://schemas.microsoft.com/cdo/configuration/smtpauthenticate »)=1
Mail.configuration.fields.Item(« http://schemas.microsoft.com/cdo/configuration/smtpserver »)= »smtp.gmail.com »
Mail.configuration.fields.Item(« http://schemas.microsoft.com/cdo/configuration/smtpserverport »)=25
Mail.configuration.fields.Item(« http://schemas.microsoft.com/cdo/configuration/sendusing »)=2
Mail.configuration.fields.Item(« http://schemas.microsoft.com/cdo/configuration/senusername »)= « ***@*** »
Mail.configuration.fields.Item(« http://schemas.microsoft.com/cdo/configuration/sendpassword »)= « XXXXXXXXXX@ »

Mail.Configuration.fields.Update

With Mail
.Subject = « CSD Tennis de Table – Facture »
.From = « ***@*** »
.To = Sheets (« Modele Facture »).Range (« L10 »).Value
‘.CC = « ***@*** »
. TextBody = « Merci de recevoir votre facture relative à vos engagements. Cordialement » 
.AddAttachement dossier «

End With

One error resume Next

Mail Send

Set mail = Nothing

End sub

danielc0 · Answer

Est-ce que le classeur est sur OneDrive ?

Daniel

danielc0 · Answer

Dans la fenêtre de l'éditeur VB, clique sur "Affichage" et "Fenêtre d'exécution"

Dans cette fenêtre d'exécution, entre :

?ThisWorkbook.Path

Appuie sur Entrée et copie ce qui s'affiche dans ta réponse.

Daniel

xavier62000 · Answer

Le fichier se trouve dans Dropbox :

C:\Users\user\Dropbox\CSD Finance

Il sera partagé avec une autre personne pour une utilisation partagée.

Xavier

xavier62000 · Answer

Le fichier se trouve dans Dropbox :

Dans l'éditeur il répond :

C:\Users\user\Dropbox\CSD Finance

Xavier

xavier62000 · Answer

oui, bien entendu.

Je ferai plusieurs essais

danielc0 · Answer

Le caracctère ":" n'est pas autorisé dans les noms de fichier ou de dossier. Je mets "

Factures PDF" provisoirement.

Daniel

danielc0 · Answer

J'ai dû ôter les espaces au début et à la fin des noms de dossier qui ne sont pas autorisés non plus. Essaie :

Sub EXPORT_PDF()
  Dim Dossier
  Dim Chemin As String
  Dim ws As Worksheet
  Set ws = ActiveSheet
  If MsgBox(" Voulez vous exporter la facture en PDF ", vbYesNo + vbQuestion, "Confirmation….. ! ") = vbYes Then
    On Error Resume Next
        Dossier = Application.InputBox("Insérer nom du dossier", "Création du dossier", "Factures PDF")
    Chemin = ThisWorkbook.Path & "\" & Dossier & "\"
    Var = Dir(Chemin, vbDirectory)
    If Var = "" Then
      On Error GoTo 0
      ChDir ThisWorkbook.Path
      
      MkDir ThisWorkbook.Path & "\" & Dossier
    End If
      ws.ExportAsFixedFormat xlTypePDF, Chemin & Range("E5").Value & " _ " & Range("L1").Value, _
      xqualitystandard, True, False, 1, 1, False
  End If
End Sub

Daniel

danielc0 · Answer

Avant que je m'attaque à ton problème de courrier, confirme que tu souhaites envoyer le fichier par mail sans passer par OutLook.

Daniel

Dormeur74 · Answer

Trouvé plusieurs erreurs dans ce code. Proposition :

Option Explicit

Sub EXPORT_PDF()
    Dim Dossier
    Dim Chemin As String
    Dim ws As Worksheet
    
    Set ws = ActiveSheet
    If MsgBox(" Voulez vous exporter la facture en PDF ", vbYesNo + vbQuestion, "Confirmation….. ! ") = vbYes Then
        On Error Resume Next
        
        Dossier = Application.InputBox("Insérer nom du dossier", "Création du dossier", "Factures PDF")
        Chemin = ThisWorkbook.Path & "\" & Dossier
        If Dossier = True Then
            GetAttr (Chemin) And vbDirectory
        Else
            MkDir (Chemin)
        End If
        ws.ExportAsFixedFormat xlTypePDF, Chemin & "\" & Range("E5").Value & " _ " & Range("L1").Value, xlQualityStandard, True, False, 1, 1, False
    End If
End Sub

xavier62000 · Answer

Bonjour Daniel,

Impeccable, sa fonctionne très bien.

Alors Oui, je souhaite envoyer :mes factures sans Outloock et dans le cas présent se sera avec Gmail. Je regarderai plus tard si je trouve les éléments de paramétrage avec SFR.

Juste pour savoir, j'ai a peu près 100 factures à faire par mois et à envoyer. Serait-il possible de faire une boucle des factures 1 à la dernière et les envoyer ensuite par mail.

Faut-il t'envoyer le code que j'ai préparé, je n'arrive pas à attacher la facture dans le mail. ??

A contrario, se sera 1 par 1 pas de soucis

Merci Cordialement

danielc0 · Answer

J'ai besoin de savoir quel est ton compte mail (par exemple xxxx.GMAIL.COM).

Daniel

xavier62000 · Answer

Envoyer en MP

xavier

xavier62000 · Answer

Voilà ce que j'ai commencé pour envoyer le mail lié à la facture.

Hic, je n'arrive pas à attacher la facture au mail

Dim mail as CDO.Message
Set Mail = New CDO.Message
Mail.configuration.fields.Item(« http://schemas.microsoft.com/cdo/configuration/smtpusessl »)=True
Mail.configuration.fields.Item(« http://schemas.microsoft.com/cdo/configuration/smtpauthenticate »)=1
Mail.configuration.fields.Item(« http://schemas.microsoft.com/cdo/configuration/smtpserver »)= »smtp.gmail.com »
Mail.configuration.fields.Item(« http://schemas.microsoft.com/cdo/configuration/smtpserverport »)=25
Mail.configuration.fields.Item(« http://schemas.microsoft.com/cdo/configuration/sendusing »)=2
Mail.configuration.fields.Item(« http://schemas.microsoft.com/cdo/configuration/senusername »)= « ***@*** »
Mail.configuration.fields.Item(« http://schemas.microsoft.com/cdo/configuration/sendpassword »)= « XXXXXXXXXXx »
Mail.Configuration.fields.Update

With Mail
.Subject = « CSD Tennis de Table – Facture »
.From = « ***@*** »
.To = Sheets (« Modele Facture »).Range (« L10 »).Value
‘.CC = « ***@*** »
. TextBody = « Merci de recevoir votre facture relative à vos engagements. Cordialement » 
.AddAttachement dossier & »facture

End With
One error resume Next
Mail Send
Set mail = Nothing
End sub

danielc0 · Answer

J'en déduis que l'adresse avec laquelle tu envoies le mail est une adresse GMail ?

Daniel

xavier62000 · Answer

Oui, c'est bien ça. Je t'ai envoyé mon compte gmail en MP

danielc0 · Answer

Bonjour,

Ca a l"air assez compliqué avec GMail. Tu dois avoir un mot de passe "GMail App Password. Pour en créer un :(c'est en anglais) :

Au besoin, je peux le traduire. Je vais t'nvoyer le code mais je ne peux pa le tester moi-même.

Daniel

danielc0 · Answer

Bonjour,

Je viens d'en avoir la confirmation, CDO ne fonctionne plus.

Daniel

xavier62000 · Answer

Bonsoir Daniel,

Je vais devoir me convertir à Outlook donc avec un compte autre que le mien.

xavier62000 · Answer

Bonsoir Daniel

Compte Outlook créer et envoyé en MP

Bonne soirée

xavier

danielc0 · Answer

Teste le code ci-dessous. Il faut modifier la 4e ligne pour indiquer l'adresse du compte expéditeur :

Expediteur = "XXXX@XXXX.com"

Sub Mail()
  Dim NS As Object, GaddressList, Expediteur As String, Exp As Object
  Dim M As Object, olApp As Object, oAccount As Object
  Expediteur = "XXXX@XXXX.com"
  Set olApp = CreateObject("Outlook.application")
  For Each oAccount In olApp.Session.Accounts
    Debug.Print oAccount.smtpaddress
    If oAccount.smtpaddress = Expediteur Then
      Set M = olApp.CreateItem(olMailItem)
      With M
        .Subject = "CSD Tennis de Table – Facture"
        .Body = "Merci de recevoir votre facture relative à vos engagements. Cordialement"
        .Recipients.Add Sheets("Modele Facture ").Range("L10").Value
        Set .sendusingaccount = oAccount
        .attachments.Add "c:\XXXXXX.pdf"
        .Send
      End With
      Exit For
    End If
  Next
End Sub

Daniel

xavier62000 · Answer

Bonjour Daniel,

Désolé de répondre tardivement !!

j'ai un problème de configuration avec Outlook. Donc je ne peux pas dire si c'est OK

xavier62000 · Answer

Voilà le message d'erreur.

Et dans mon compte, je ne vois pas de problème

xavier62000 · Answer

j'ai les 2.

Outlook classicisme et outlook de microsoft 365

xavier62000 · Answer

le message se produit après la macros d excel.

faut il desinstaller outlook de microsoft 365.

c'est le classic qui va pas

danielc0 · Answer

Non, j'ai testé avec Outlook 365 classic sans erreur. Est-ce que tu t'es connecté à ton compte Microsoft comme ils te le disent ?

Daniel

xavier62000 · Answer

oui. mais après je ne sais pas où aller et voir quoi

danielc0 · Answer

Tu ne vois rien d'anormal concernant ton abonnement à Microsoft 365 ? Sinon, Ouvre le classeur dans Excel. Appuie sur les touches Alt+F11. La fenêtre de l'éditeur VB s'ouvre. Clique dans la macro Mail.Appuie sur F8 pour exécuter la macro ligne par ligne. Recommence jusqu'à arriver à une erreur ou à la fin de la macro. Est-ce qu'il y a une erreur ?

Daniel

xavier62000 · Answer

on est bien d'accord que je dois utiliser le classic et non le nouvel outlook ??

danielc0 · Answer

Normalement, on doit pouvoir utiliser les deux. Moi, j'ai testé avec Classic. New me sort par les yeux, mais c'est uniquement un différence d'interface utilisateur. Donc aucune différence pour les macros.

Daniel

xavier62000 · Answer

voilà ce que ça fait

2°) Je rentre le mot de passe

3°)

Est dans mon compte d'abonnement je ne sais pas quoi faire ce n'est pas moi qui gère, trop compliqué pour moi.

Quand je lance outloock classic sans passer par le fichier Excel c'est pareil.

Idem quand jutilise l'adresse mail du lien Hypertexte

danielc0 · Answer

Une fois que tu es là, clique sur le menu "Affichage" et "Fenêtre variables locales". Dan cette fen^tre, clique sur le "+" en regard de olApp pour déplier les propriétés. Déplie "Session" et "Accounts". En dessous de "Accounts", quel nombre y a-t-il en face de "Count" ?

Daniel

danielc0 · Answer

Exécute aussi cette macro qui doit afficher le numéro et le libellé de l'erreur.

Sub Mail()
  Dim NS As Object, GaddressList, Expediteur As String, Exp As Object
  Dim M As Object, olApp As Object, oAccount As Object
  Expediteur = "XXXX@XXXX.com"
  Set olApp = CreateObject("Outlook.application")
  On Error Resume Next
  For Each oAccount In olApp.Session.Accounts
    MsgBox Err.Number & " " & Err.Description
    Exit Sub
    Debug.Print oAccount.smtpaddress
    If oAccount.smtpaddress = Expediteur Then
      Set M = olApp.CreateItem(olMailItem)
      With M
        .Subject = "CSD Tennis de Table – Facture"
        .Body = "Merci de recevoir votre facture relative à vos engagements. Cordialement"
        .Recipients.Add Sheets("Modele Facture ").Range("L10").Value
        Set .sendusingaccount = oAccount
        .attachments.Add "c:\XXXXXX.pdf"
        .Send
      End With
      Exit For
    End If
  Next
End Sub

Daniel

xavier62000 · Answer

Bonjour Daniel,

Désolé, de repondre tardivement

Voilà pour les variables locales j'ai strictement rien

Et Pour l'execution de la macro pas de numéro ni de libellé d'erreur

xavier62000 · Answer

Quand je lance Outlook classique tout seul il me donne le message suivant :

danielc0 · Answer

Bonjour,

Sur mon ordi perso, je ferais une réparation d'Office. Maintenant, tu dois être dans un environnement d'entreprise; tu devrais donc voir avec le responsable informatique. De toutes façons, je ne pense pas que la macro puisse fonctionner avec Exchange. Je n'utilise pas Exchange donc je ne peux pas de fournir une solution. Je vais donc arrêter là ma participation au fil.

Daniel

Nain_Porte_Quoi · Answer

Hello,

Voici le code qui permet d'envoyer un mail via le serveur SMTP de la connexion active (sans Outlook)

Sub mail()

Set Message = CreateObject("cdo.Message")

' configuration de la messagerie
    With Message.Configuration.Fields
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = nom du serveur SMTP de la connexion active (ex : "smtp.free.fr")
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = Numéro du port d'envoi (465 généralement en SSL/TLS)
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = nom du compte utilisateur de la BàL utilisé pour l'envoi (ex : si "***@***", utiliser "toto")
        .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = mot de passe du compte utilisateur de la BàL utilisé pour l'envoi (ex : "password")
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60
        
        .Update
    End With

'  configuration du message
    With Message
        .Subject = "CSD Tennis de Table – Facture"
        .From = "Mon adresse ***@***"
        .To = Sheets("Modele Facture").Range("L10").Value
        '‘.CC = « ***@*** »
        .TextBody = "Veuillez trouver ci joint la facture relative à vos engagements. Cordialement"
        .AddAttachment ("chemin complet et nom du fichier")

.Send
    End With

Set Message = Nothing

MsgBox "Message envoyé... ou pas :-D"

End Sub

xavier62000 · Answer

OK. Je comprends bien

J'ai réparé office mais toujours le même problème  et non c'est mon ordi perso.

Juste une question avec la fonction ci-dessous est il possible d'attacher un PDF

=LIEN_HYPERTEXTE("mailto:"&L10&"?subject="&W3&"&CC="&E10&"&body="&W5;"MAIL A ENVOYER")

Bizarrement ça fonctionne avec le nouvel outlook

Merci beaucoup pour ta patience

Xavier

Nain_Porte_Quoi · Answer

Juste une question avec la fonction ci-dessous est il possible d'attacher un PDF

=LIEN_HYPERTEXTE("mailto:"&L10&"?subject="&W3&"&CC="&E10&"&body="&W5;"MAIL A ENVOYER")

Non, pour 2 raisons

1 : ça n'est pas prévu dans le mailto

2 : ça n'arrangera pas votre souci de messagerie car elle doit être configurée (correctement)

https://fr.wikipedia.org/wiki/Mailto

Export facture en PDF

45 réponses

Discussions similaires

Newsletters