Macro excel : enregistrer feuille au format pdf et envoi en piece jointe

hyperion66

XLDnaute Nouveau
Bonjour à tous et toutes,
Nouveau sur le forum, bien que cela fait un petit moment que je passe quand j'ai besoin d'aide....
Pour ma future activité, je crée une facture sous Excel. J'ai créé une macro qui permet d'enregistrer la facture dans un dossier portant le nom du client, le fichier étant automatiquement nommé avec la date et le numéro de facture. Voilà le code.
Code:
Sub Enregistrement()
Dim Chemin1$, Chemin2$, Client$, Fichier$, Numfact$, Jour$
Chemin1 = "D:\Gestion\Factures\"
Chemin2 = "H:\Zerobug backup\Factures\"
Jour = Format(Day(Now()), "00") & Format(Month(Now()), "00") & Year(Now)
Client = Range("G4")
Numfact = Range("H12")
Fichier = Jour & "_" & Numfact & ".xls"
If Dir(Chemin1 & Client, 16) = "" Then MkDir Chemin1 & Client
ActiveWorkbook.SaveAs Chemin1 & Client & "\" & Fichier
If Dir(Chemin2 & Client, 16) = "" Then MkDir Chemin2 & Client
ActiveWorkbook.SaveAs Chemin2 & Client & "\" & Fichier
End Sub
Maintenant, je cherche à ce que ma feuille soit automatiquement générée en PDF avec le même nom et, si possible, qu'un mail soit automatiquement ouvert avec le fichier au format PDF en pièce jointe.
Si quelqu'un peut m'aider......
 

jeanpierre

Nous a quitté
Repose en paix
Re : Macro excel : enregistrer feuille au format pdf et envoi en piece jointe

Bonjour hyperion66, le forum,

Rendez-vous en page Accueil, et ensuite le WIKI de Michel XLD, un petit monument qui devrait t'apporter bien des réponses.

Bon week-end.

Jean-Pierre
 

jeanpierre

Nous a quitté
Repose en paix
Re : Macro excel : enregistrer feuille au format pdf et envoi en piece jointe

Re,

Désolé de ne pouvoir t'aider plus...

Même si j'aime le tout automatique, il m'arrive de faire contre mauvaise fortune bon coeur...

Deux ou trois manip.... de plus... et c'est bon.

Je n'ai, finalement, qu'une confiance relative en l'informatique...

Nous allons donc attendre, ensemble, l'avis des casse-cou du Vba.....

Bonne fin de journée...

Jean-Pierre
 

hyperion66

XLDnaute Nouveau
Re : Macro excel : enregistrer feuille au format pdf et envoi en piece jointe

Bon, ça progresse doucement, mais toujours pas au point.

Voilà la dernière version de ma macro :
Code:
Sub Enregistrement()
Dim Chemin1$, Chemin2$, Client$, Fichier$, Numfact$, Jour$, F$, N$
Chemin1 = "H:\Zerobug backup\Factures\"
Chemin2 = "D:\Gestion\Factures\"
Jour = Format(Now(), "ddmmyyyy")
Client = Range("H7")
Numfact = Range("I15")
Fichier = Jour & "_" & Numfact & ".xls"
If Dir(Chemin1 & Client, 16) = "" Then MkDir Chemin1 & Client
ActiveWorkbook.SaveAs Chemin1 & Client & "\" & Fichier
If Dir(Chemin2 & Client, 16) = "" Then MkDir Chemin2 & Client
ActiveWorkbook.SaveAs Chemin2 & Client & "\" & Fichier
N = Jour & "_" & Numfact
F = Application.GetSaveAsFilename(N, "fichier pdf,*.pdf")
    Application.ActivePrinter = "Adobe PDF sur Ne03:"
    SendKeys N & "{ENTER}", False
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, ActivePrinter:= _
                                         "Adobe PDF sur Ne03:"
  End Sub
Donc, ça m'enregistre bien mon fichier XLS avec le bon nom et dans le bon dossier (nom et prénom du client qui fait référence à la cellule H7), ça me lance ensuite "l'impression" PDF via l'imprimante Acrobat, avec là aussi le bon nom. Mais je dois sélectionner le dossier de destination, et même en sélectionnant le bon dossier de destination, il l'enregistre dans C:\Mes Documents (qui fait référence au port de l'imprimante PDF). Vous me direz bien que le plus simple serait de modifier le port de l'imprimante, mais vu que chaque PDF est enregistré dans un dossier différent, ça ne me convient pas.
Je rappelle que j'utilise Acrobat 7.

Merci à l'âme charitable qui pourrait venir me donner un coup de main.
 

hyperion66

XLDnaute Nouveau
Re : Macro excel : enregistrer feuille au format pdf et envoi en piece jointe

J'ai essayé de remplacer
Code:
Jour = Format(Now(), "ddmmyyyy")
par
Code:
Jour = Range = ("M1")
pour qu'il prenne non pas la date du jour mais la date qui est dans la cellule M1, mais ça me provoque une erreur au niveau de :
Code:
If Dir(Chemin1 & Client, 16) = "" Then MkDir Chemin1 & Client
Pourquoi ?
 

hyperion66

XLDnaute Nouveau
Re : Macro excel : enregistrer feuille au format pdf et envoi en piece jointe

hyperion66 à dit:
J'ai essayé de remplacer
Code:
Jour = Format(Now(), "ddmmyyyy")
par
Code:
Jour = Range = ("M1")
pour qu'il prenne non pas la date du jour mais la date qui est dans la cellule M1, mais ça me provoque une erreur au niveau de :
Code:
If Dir(Chemin1 & Client, 16) = "" Then MkDir Chemin1 & Client
Pourquoi ?
Message annulé, c'est bon, j'ai trouvé !
 

hyperion66

XLDnaute Nouveau
Re : Macro excel : enregistrer feuille au format pdf et envoi en piece jointe

Bon, en posant la question sur divers forums, j'avance doucement.

Voilà où en est le code :
Code:
'    VBA Menu Outils | Références COCHER Acrobat Distiller
'                                 COCHER Microsoft CDO Exchange xxxx Library
 
Option Explicit
 
Sub Enregistrement()
Dim Chemin1 As String, Chemin2 As String
Dim Client As String
Dim Fichier As String
Dim Numfact As String
Dim Jour As String
Dim sNomFichier As String
 
    Chemin1 = "D:\Gestion\Factures"
    Chemin2 = "H:\Zerobug backup\Factures"
 
    Jour = Format(Range("H13"), "ddmmyyyy")
    Client = Range("H7")
    Numfact = Range("I15")
 
    If Len(Client) = 0 Then
        MsgBox "Cellule Client vide", vbOKOnly
        Exit Sub
    End If
    If Len(Numfact) = 0 Then
        MsgBox "Cellule N° Facture incorrecte", vbOKOnly
        Exit Sub
    End If
 
    Fichier = Jour & "_" & Numfact & ".xls"
 
    If CreationDossiers(Chemin1 & "\" & Client) = False Then
        MsgBox "Création dossier impossible" & vbCrLf & Chemin1 & Client, vbOKOnly
        Exit Sub
    Else
        ActiveWorkbook.SaveAs Chemin1 & "\" & Client & "\" & Fichier
    End If
 
    If CreationDossiers(Chemin2 & "\" & Client) = False Then
        MsgBox "Création dossier impossible" & vbCrLf & Chemin2 & Client, vbOKOnly
        Exit Sub
    Else
        ActiveWorkbook.SaveAs Chemin2 & "\" & Client & "\" & Fichier
    End If
     
    sNomFichier = Jour & "_" & Numfact
     
    GenererPDFDistiller Chemin1, sNomFichier
End Sub
 
Sub GenererPDFDistiller(ByVal Chemin As String, ByVal NomDuFichier As String)
Dim CdoMessage As CDO.Message
Dim PDFDist As PDFDistiller
Dim sNomFichierPS As String
Dim sNomFichierPDF As String
 
    sNomFichierPS = Chemin & "\" & NomDuFichier & ".ps"
    sNomFichierPDF = Chemin & "\" & NomDuFichier & ".pdf"
 
    If IsEmpty(ActiveSheet.UsedRange) Then Exit Sub
 
    ActiveSheet.PrintOut copies:=1, Preview:=False, _
        ActivePrinter:="Acrobat Distiller", PrintToFile:=True, _
        Collate:=True, PrToFileName:=sNomFichierPS
         
    Set PDFDist = New PDFDistiller
    PDFDist.FileToPDF sNomFichierPS, sNomFichierPDF, ""
         
    Set CdoMessage = New CDO.Message
    With CdoMessage
        .Subject = "Votre facture"
        .From = "contact@zerobug.fr"
        .To = Range("G10")
        .TextBody = "Texte dans le corps de message"
        .AddAttachment sNomFichierPDF
        .Send
    End With
     
    Kill sNomFichierPS
    Kill sNomFichierPDF
    Kill Chemin & "\" & NomDuFichier & ".log"
     
    Set PDFDist = Nothing
    Set CdoMessage = Nothing
End Sub
 
Private Function CreationDossiers(ByVal Chemin As String) As Boolean
Dim i As Long
Dim sTmp As String
Dim Ar() As String
 
    If InStr(1, Chemin, ":") = 0 Then
        Ar = Split(CurDir & Chemin, "\")
    Else
        Ar = Split(Chemin, "\")
    End If
 
    sTmp = Ar(0)
    For i = LBound(Ar) + 1 To UBound(Ar)
        If Ar(i) <> "" Then
            sTmp = sTmp & "\" & Ar(i)
            On Error Resume Next
            MkDir sTmp
            On Error GoTo 0
        End If
    Next
 
    If Dir(Chemin, vbDirectory) = "" Then
        On Error Resume Next
        RmDir Ar(0) & "\" & Ar(1)
        On Error GoTo 0
    Else
        CreationDossiers = True
    End If
End Function

Avec tout ça, il me génère bien .ps et .log dans le dossier Factures, mais il ne génère pas le .pdf !! D'où une erreur lors de la création du mail. Il ne manque pas une ligne pour transformer le PS en PDF ?
 

Staple1600

XLDnaute Barbatruc
Re : Macro excel : enregistrer feuille au format pdf et envoi en piece jointe

Re


Dans ce cas, désolé, je ne pourrais t'aider (Acrobat est bien trop cher pour moi)

N'y aurait t-il pas de solution sans utiliser Acrobat?

(Comme font certains logiciels libres pour génerer des pdfs)
 

Staple1600

XLDnaute Barbatruc
Re : Macro excel : enregistrer feuille au format pdf et envoi en piece jointe

Re

Je dis juste cela pour ceux qui ne possèdent pas Acrobat
(et je ne parle pas d'Acrobat Reader qui est gratuit)
et qui comme toi veulent générer des fichiers pdfs à partir d'Excel
par VBA.

Une solution alternative sans utiliser Acrobat aurait permis au plus grand nombre de générer des pdfs sous Excel

dommage que cela ne semble pas à priori possible
(sauf erreur de ma part)
 

hyperion66

XLDnaute Nouveau
Re : Macro excel : enregistrer feuille au format pdf et envoi en piece jointe

J'ai envoyé le fichier Excel à un collègue chez qui la macro marche impec !!!
Chez moi, j'ai une erreur tout simplement parce-que Distiller n'arrive pas à créer le PDF.
Voici l'erreur qui apparaît dans le journal de Distiller :
Code:
Acrobat Distiller 7.0 
Début : lundi 11 juin 2007 à 14:10:35 
 
Adobe PostScript :3016.102 
 
Heure de début : lundi 11 juin 2007 à 14:10:36 
Source : 01042007_KIKI39173.ps 
Destination : D:\Gestion\Factures\01042007_KIKI39173.pdf 
Options Adobe PDF : C:\Documents and Settings\All Users\Documents\Adobe PDF\Settings\Smallest File Size.joboptions 
%%[ Error: undefined; OffendingCommand: K ]%% 
 
Stack: 
-mark- 
 
 
%%[ Flushing: rest of job (to end-of-file) will be ignored ]%% 
%%[ Warning: PostScript error. No PDF file produced. ] %% 
Durée de conversion : 0 secondes (00:00:00) 
**** Fin du travail ****
Savez-vous comment régler le problème ?
 

lodam

XLDnaute Occasionnel

Discussions similaires

Statistiques des forums

Discussions
311 705
Messages
2 081 721
Membres
101 803
dernier inscrit
astyx26