Forum |  HardWare.fr | News | Articles | PC | S'identifier | S'inscrire | Shop Recherche
649 connectés 

  FORUM HardWare.fr
  Programmation
  VB/VBA/VBS

  Macro Excel : enregistrer feuille en PDF et envoi pièce jointe

 


 Mot :   Pseudo :  
 
 Page :   1  2
Page Précédente
Auteur Sujet :

Macro Excel : enregistrer feuille en PDF et envoi pièce jointe

n°1572656
hyperion66
Posté le 09-06-2007 à 09:19:03  profilanswer
 

Et oui, encore moi avec mes macros.
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 :
  1. Sub Enregistrement()
  2. Dim Chemin1$, Chemin2$, Client$, Fichier$, Numfact$, Jour$
  3. Chemin1 = "D:\Gestion\Factures\"
  4. Chemin2 = "H:\Zerobug backup\Factures\"
  5. Jour = Format(Day(Now()), "00" ) & Format(Month(Now()), "00" ) & Year(Now)
  6. Client = Range("G4" )
  7. Numfact = Range("H12" )
  8. Fichier = Jour & "_" & Numfact & ".xls"
  9. If Dir(Chemin1 & Client, 16) = "" Then MkDir Chemin1 & Client
  10. ActiveWorkbook.SaveAs Chemin1 & Client & "\" & Fichier
  11. If Dir(Chemin2 & Client, 16) = "" Then MkDir Chemin2 & Client
  12. ActiveWorkbook.SaveAs Chemin2 & Client & "\" & Fichier
  13. 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......


Message édité par hyperion66 le 09-06-2007 à 09:22:02

---------------
MATOS VELO - Club Strava Matos Vélo
mood
Publicité
Posté le 09-06-2007 à 09:19:03  profilanswer
 

n°1572662
jpcheck
Pioupiou
Posté le 09-06-2007 à 10:03:14  profilanswer
 

bonjour deja,
quel logiciel de création de pdfas-tu sous la main ?

n°1572664
hyperion66
Posté le 09-06-2007 à 10:16:56  profilanswer
 

Oups, trop pressé. Oui, bonjour !
J'utilise Adobe Acrobat 7


---------------
MATOS VELO - Club Strava Matos Vélo
n°1572671
jpcheck
Pioupiou
Posté le 09-06-2007 à 11:34:13  profilanswer
 

peut etre peux-tu simuler les touches de clavier pour enregistrer un document en pdf ?

n°1572686
hyperion66
Posté le 09-06-2007 à 12:20:08  profilanswer
 

J'ai essayé, pas de touche clavier pour le pdf.


---------------
MATOS VELO - Club Strava Matos Vélo
n°1572699
jpcheck
Pioupiou
Posté le 09-06-2007 à 13:26:01  profilanswer
 

tu peux pas faire un systeme du genre :
shellexecute (adobe.exe)
sendkeys "N"
et la cinématique pour ouvrir le doc excel de départ etc ?

n°1572710
hyperion66
Posté le 09-06-2007 à 14:39:08  profilanswer
 

Je n'en sais rien, je ne connais pas grand chose au VBA.


---------------
MATOS VELO - Club Strava Matos Vélo
n°1572782
jpcheck
Pioupiou
Posté le 09-06-2007 à 18:19:06  profilanswer
 

peux tu me donner la séquence de raccourcis clavier que tu utilises pour ouvrir un fichier, et l'enregistrer sous un format pdf.
ex :
Ctrl N pour fichier nouveau...

n°1572789
hyperion66
Posté le 09-06-2007 à 19:22:07  profilanswer
 

Je n'utilise aucun raccourci clavier. Il n'y en a pas pour le PDF.


---------------
MATOS VELO - Club Strava Matos Vélo
n°1572804
kiki29
Posté le 09-06-2007 à 21:55:24  profilanswer
 

Utilise le macro recorder et l'imprimante virtuelle Acrobat Pdf  
puis optimise et adapte manuellement
sinon il faut aller voir sur http://www.rondebruin.nl/sendmail.htm
qui permet de joindre un feuille Xl en pj à un mail


Message édité par kiki29 le 09-06-2007 à 22:03:03
mood
Publicité
Posté le 09-06-2007 à 21:55:24  profilanswer
 

n°1572806
hyperion66
Posté le 09-06-2007 à 22:07:38  profilanswer
 

J'ai essayé avec le bouton recorder, ça ne marche pas !


---------------
MATOS VELO - Club Strava Matos Vélo
n°1572808
kiki29
Posté le 09-06-2007 à 22:14:47  profilanswer
 

Déjà avec le macro recorder et l'imprimante virtuelle Adobe pdf
tu devrais obtenir qqch comme


    Application.ActivePrinter = "Adobe PDF sur Ne03:"
    ActiveWindow.SelectedSheets.PrintOut From:=1, To:=1, Copies:=1, _
        ActivePrinter:="Adobe PDF sur Ne03:", Collate:=True


 
puis ensuite  
Menu VBA Outils | Références : Cocher Microsoft CDO for Exchange xxxx Library


 
Sub tst()
Dim objMessage As CDO.Message
    Set objMessage = CreateObject("CDO.Message" )
    With objMessage
        .Subject = "Example CDO Message"
        .From = "x@x.fr"
        .To = "y@y.fr"
        .TextBody = "texte dans le corps de message"
        .AddAttachment "c:\tonfichier.pdf"
        .Send
    End With
End Sub


 
solution déjà donnée sur ce même forum !!


Message édité par kiki29 le 09-06-2007 à 22:40:52
n°1572813
kiki29
Posté le 09-06-2007 à 22:55:12  profilanswer
 

Au final


Option Explicit
 
 
' Menu VBA Outils | Références : Cocher Microsoft CDO for Exchange xxxx Library
Sub Tst()
Dim objMessage As CDO.Message
 
    ActiveWindow.SelectedSheets.PrintOut From:=1, To:=1, Copies:=1, _
        ActivePrinter:="Adobe PDF sur Ne03:", Collate:=True
     
    If Application.Wait(Now + TimeValue("0:00:10" )) Then
        Set objMessage = CreateObject("CDO.Message" )
        With objMessage
            .Subject = "Example CDO Message"  
            .From = "x@x.fr"  
            .To = "y@y.fr"  
            .TextBody = "texte dans le corps de message"  
            .AddAttachment "c:\tonfichier.pdf"  
            .Send  
        End With
        Set objMessage =Nothing
    End If
End Sub


Message édité par kiki29 le 10-06-2007 à 03:43:11
n°1572815
hyperion66
Posté le 09-06-2007 à 23:23:03  profilanswer
 

Effectivement, j'ai réessayé, j'obtiens ça :

Application.ActivePrinter = "Adobe PDF sur Ne03:"  
    ActiveWindow.SelectedSheets.PrintOut From:=1, To:=1, Copies:=1, _  
        ActivePrinter:="Adobe PDF sur Ne03:", Collate:=True


Mais il faudrait que le fichier soit automatiquement créé dans le bon dossier et le bon nom, comme pour le fichier xls.
 
Pour le moment, je voudrais déjà créer ça correctement (si c'est faisable) avant de m'attaquer à l'envoir par mail.
 
Merci


Message édité par hyperion66 le 09-06-2007 à 23:23:40

---------------
MATOS VELO - Club Strava Matos Vélo
n°1572826
kiki29
Posté le 10-06-2007 à 05:33:58  profilanswer
 

un exemple qui utilise PDFCreator


'   http://sourceforge.net/projects/pdfcreator   PDFCreator-0_9_3_GPLGhostscript.exe
'   sous VBA Menu Outils | Références  Cocher PDFCreator
'   sous VBA Menu Outils | Références  Cocher Microsoft CDO for Exchange xxxx Library
 
Sub Tst_PdfCreator()
Dim objMessage As CDO.Message
Dim jobPDF As Object
Dim sNomPDF As String
Dim sCheminPDF As String
 
    sNomPDF = "Essai.pdf"
    sCheminPDF = ActiveWorkbook.Path & Application.PathSeparator
 
    If IsEmpty(ActiveSheet.UsedRange) Then Exit Sub
 
    Set jobPDF = CreateObject("PDFCreator.clsPDFCreator" )
 
    With jobPDF
        If .cStart("/NoProcessingAtStartup" ) = False Then
            MsgBox "Initialisation de PDFCreator impossible", vbCritical + vbOKOnly, "PDFCreator"
            Exit Sub
        End If
        .cOption("UseAutosave" ) = 1
        .cOption("UseAutosaveDirectory" ) = 1
        .cOption("AutosaveDirectory" ) = sCheminPDF
        .cOption("AutosaveFilename" ) = sNomPDF
 
        '0=PDF, 1=Png, 2=jpg, 3=bmp, 4=pcx, 5=tif, 6=ps, 7=eps, 8=txt
        .cOption("AutosaveFormat" ) = 0    
        .cClearCache
    End With
 
    ActiveSheet.PrintOut copies:=1, ActivePrinter:="PDFCreator"
 
    'Fichier dans la file d'attente
    Do Until jobPDF.cCountOfPrintjobs = 1
        DoEvents
    Loop
    jobPDF.cPrinterStop = False
 
    'Attendre que la file d'attente soit vide
    Do Until jobPDF.cCountOfPrintjobs = 0
        DoEvents
    Loop
    jobPDF.cClose
    Set jobPDF = Nothing
     
    Set objMessage = CreateObject("CDO.Message" )
    With objMessage
        .Subject = "Essai"
        .From = "xxxxx@wanadoo.fr"
        .To = "yyyyy@wanadoo.fr"
        .TextBody = "Texte dans le corps de message"
        .AddAttachment sCheminPDF & sNomPDF
        .Send
    End With
     
    Set objMessage = Nothing
End Sub


Message édité par kiki29 le 10-06-2007 à 08:29:42
n°1572926
hyperion66
Posté le 10-06-2007 à 19:10:58  profilanswer
 

Bon, ça progresse doucement, mais toujours pas au point.
 
Voilà la dernière version de ma macro :

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.


Message édité par hyperion66 le 10-06-2007 à 19:15:36

---------------
MATOS VELO - Club Strava Matos Vélo
n°1572940
kiki29
Posté le 10-06-2007 à 20:36:43  profilanswer
 

Moi aussi j'ai Acrobat mais si je t'ai donné une version avec PDFCreator c'est que cela était possible et ce n'est pas faute d'avoir cherché sur Adobe.


Message édité par kiki29 le 11-06-2007 à 03:15:15
n°1572989
kiki29
Posté le 11-06-2007 à 03:17:10  profilanswer
 

A toi de l'adapter, en fait il fallait passer par Distiller


Private GenererPDFDistiller()
Dim CdoMessage As CDO.Message
Dim sNomFichierPS As String
Dim sNomFichierPDF As String
Dim PDFDist As PdfDistiller
 
    sNomFichierPS = ThisWorkbook.Path & "\Essai_Distill.ps"
    sNomFichierPDF = ThisWorkbook.Path & "\Essai_Distill.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 = "Exemple Distiller"
        .From = "xxxxx@wanadoo.fr"
        .To = "yyyyy@wanadoo.fr"
        .TextBody = "Texte dans le corps de message"
        .AddAttachment sNomFichierPDF
        .Send
    End With
     
    Kill sNomFichierPS
    Kill ThisWorkbook.Path & "\Essai_Distill.log"
 
    Set CdoMessage = Nothing
    Set PDFDist = Nothing
End Sub


Message édité par kiki29 le 11-06-2007 à 07:06:24
n°1572993
kiki29
Posté le 11-06-2007 à 05:10:05  profilanswer
 

Pour la création correcte de tes dossiers et sous dossiers
 


....
    If CreationDossiers(Chemin1 & Client) = False Then
        MsgBox "Création dossier impossible" & vbCrLf & Chemin1 & Client, vbOKOnly
        Exit Sub
    Else
        ActiveWorkbook.SaveAs  .....
    End If
....


 
ici une fonction de création des dossiers et sous dossiers
 


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


 
Il ne te reste plus qu'a faire ta cuisine en modifiant Sub GenererPDFDistiller pour lui passer le chemin et nom de fichier en parametres GenererPDFDistiller(ByVal Chemin As String, ByVal NomDuFichier As String)


Message édité par kiki29 le 11-06-2007 à 07:02:27
n°1573001
hyperion66
Posté le 11-06-2007 à 08:22:31  profilanswer
 

Houla, je crois que ça deviens trop compliqué pour moi tout ça !
Surtout dans le second code, où est-ce que je rentre le sous-dossiers "Année" ?
Et puis elle y est l'imprimante Distiller avec Acrobat 7 ? En tous cas, elle n'apparaît pas avec ma liste d'imprimantes.
 
En tous cas, merci pour ton aide.


Message édité par hyperion66 le 11-06-2007 à 08:25:04

---------------
MATOS VELO - Club Strava Matos Vélo
n°1573002
kiki29
Posté le 11-06-2007 à 08:37:10  profilanswer
 

Réalisé sur la gaz à partir de ton 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 = "C:\Transfert\EssaisPdf\Factures"
    Chemin2 = "D:\Transfert\EssaisPdf\Factures"
 
    Jour = Format(Now(), "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 = "Exemple"
        .From = "xxxxx@wanadoo.fr"
        .To = "yyyyy@wanadoo.fr"
        .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


Message édité par kiki29 le 11-06-2007 à 10:55:18
n°1573003
hyperion66
Posté le 11-06-2007 à 08:46:17  profilanswer
 

Une erreur se produit ici :

Sub GenererPDFDistiller(ByVal Chemin As String, ByVal NomDuFichier As String)
Dim CdoMessage As CDO.Message


 
Par contre, à quoi sert l'option Explicit ?


---------------
MATOS VELO - Club Strava Matos Vélo
n°1573019
kiki29
Posté le 11-06-2007 à 09:46:59  profilanswer
 

Il ne faut pas oublier :
VBA Menu Outils | Références COCHER Acrobat Distiller
                                                    Microsoft CDO Exchange xxxx Library
 
Explicit [F1] => Aide en ligne


Message édité par kiki29 le 11-06-2007 à 09:49:40
n°1573059
hyperion66
Posté le 11-06-2007 à 10:39:08  profilanswer
 

Il me met une erreur "Cellule N° Facture incorrecte". Je pense que cela vient du fait que tu as mis dans le code :

If Len(Numfact) = 0 Or Not (IsNumeric(Numfact)) Then


Or, le numéro de facture est de type ROBE31976 par exemple !
Comment corriger cette ligne ?


---------------
MATOS VELO - Club Strava Matos Vélo
n°1573061
jpcheck
Pioupiou
Posté le 11-06-2007 à 10:40:44  profilanswer
 

si ton nombre de caracteres reste fixe avec ROBE ou quoi que ce soit en 4 caractere puis un nombre, utilise la fonction mid() [F1]

n°1573064
kiki29
Posté le 11-06-2007 à 10:44:02  profilanswer
 

Correction du code effectuée en supprimant Or Not (IsNumeric(Numfact))


Message édité par kiki29 le 11-06-2007 à 10:48:53
n°1573082
hyperion66
Posté le 11-06-2007 à 10:59:10  profilanswer
 

Erreur :

Dim CdoMessage As CDO.Message


Je ne trouve pas Microsoft CDO Exchange xxxx Library


Message édité par hyperion66 le 11-06-2007 à 11:09:45

---------------
MATOS VELO - Club Strava Matos Vélo
n°1573118
hyperion66
Posté le 11-06-2007 à 11:31:09  profilanswer
 

Bon, merci pour votre aide, ça avance.....
 
Chez moi, ça ne s'appelle pas Microsoft CDO Exchange xxxx Library mais Microsoft CDO for Windows 2000 Library
 
Voilà où en est le 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 ?


---------------
MATOS VELO - Club Strava Matos Vélo
n°1573122
kiki29
Posté le 11-06-2007 à 11:36:57  profilanswer
 

Il faut être loggé en administrateur

n°1573136
hyperion66
Posté le 11-06-2007 à 11:50:22  profilanswer
 

Je suis loggué en admin.


---------------
MATOS VELO - Club Strava Matos Vélo
n°1573143
kiki29
Posté le 11-06-2007 à 11:55:46  profilanswer
 

Ici je n'ai strictement aucun problemes , Quelle message d'erreur as-tu ?
il faut passer en mode pas à pas et déterminer ( si possible ) l'endroit qui amene cette erreur
 
Quand tu double clique sur le fichier PS cela doit lancer Acrobat Distiller et générer le PDF ?
Ici c'est le cas


Message édité par kiki29 le 11-06-2007 à 12:15:34
n°1573162
hyperion66
Posté le 11-06-2007 à 12:20:01  profilanswer
 

Erreur d'exécution '-2147024894 (80070002)' :
Le fichier spécifié est introuvable
 
Si je clique sur déboguage, il m'envoit sur cette ligne :

       .AddAttachment sNomFichierPDF


 
Dans le dossier Factures, j'ai bien le .log et le .ps mais aucun .pdf !


---------------
MATOS VELO - Club Strava Matos Vélo
n°1573164
hyperion66
Posté le 11-06-2007 à 12:22:24  profilanswer
 

Je viens de voir le log de disitiller :
 
%%[ 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 ****


---------------
MATOS VELO - Club Strava Matos Vélo
n°1573166
kiki29
Posté le 11-06-2007 à 12:26:20  profilanswer
 

Ici le même log produit :
 
%%[ ProductName: Distiller ]%%
%%[ Warning: Helvetica not found, using Font Substitution. Font cannot be embedded.]%%
%%[ Warning: Helvetica-Bold not found, using Font Substitution. Font cannot be embedded.]%%
%%[Page: 1]%%
%%[LastPage]%%
 
Peut être un paramétrage de Distiller ? ou de timing ?


If Application.Wait(Now + TimeValue("00:00:10" )) Then
    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  
End If


Message édité par kiki29 le 11-06-2007 à 12:37:06
n°1573178
hyperion66
Posté le 11-06-2007 à 12:48:09  profilanswer
 

Toujours pas de création du PDF.
Y'a moyen que je te fasse passer mon doc Excel par mail pour qur tu y jettes un oeil ?


---------------
MATOS VELO - Club Strava Matos Vélo
n°1573179
kiki29
Posté le 11-06-2007 à 12:54:48  profilanswer
 

si a phmdùfldsùmflmùdslfùmdslfmùls


Message édité par kiki29 le 11-06-2007 à 13:38:04
n°1573202
kiki29
Posté le 11-06-2007 à 13:38:34  profilanswer
 

Ici tout se passe sans probleme

n°1573210
hyperion66
Posté le 11-06-2007 à 13:52:50  profilanswer
 

Zut, je ne vois pas pourquoi ça déconne chez moi. Tu as quelle version d'Acrobat ?
Tu as utilisé mon fichier sans rien modifier ?


Message édité par hyperion66 le 11-06-2007 à 13:53:15

---------------
MATOS VELO - Club Strava Matos Vélo
n°1573214
kiki29
Posté le 11-06-2007 à 14:04:35  profilanswer
 

Acrobat 6.0.6
les seules choses changées sont le chemin des fichiers
Supprimer la boucle d'attente
la ref CDO elle passe à 2000 chez moi
 
AdobePdfMakerForOffice est absent chez moi , je le décocherai chez toi pour voir


Message édité par kiki29 le 12-06-2007 à 02:57:29
n°1573216
hyperion66
Posté le 11-06-2007 à 14:06:42  profilanswer
 

Tu as donc bien Microsoft CDO for Windows 2000 Library  ?


---------------
MATOS VELO - Club Strava Matos Vélo
mood
Publicité
Posté le   profilanswer
 

 Page :   1  2
Page Précédente

Aller à :
Ajouter une réponse
  FORUM HardWare.fr
  Programmation
  VB/VBA/VBS

  Macro Excel : enregistrer feuille en PDF et envoi pièce jointe

 

Sujets relatifs
Graphique et ExcelEnvoi de donnée du serveur au client par socket
création macro pour envoie fichier excel par mail[excel/vba] Compter le nombre de fichiers dans un repertoire ?
(RESOLU) diminution du temps d'execution [VBA EXCEL][vba] copie ligne et l'inserer dans une autre feuille
Générer un fichier excel avec menus déroulantsinsertion à partir d'un fichier texte dans un fichier excel
aide pour cration d'un macro svp!!!!! 
Plus de sujets relatifs à : Macro Excel : enregistrer feuille en PDF et envoi pièce jointe


Copyright © 1997-2022 Hardware.fr SARL (Signaler un contenu illicite / Données personnelles) / Groupe LDLC / Shop HFR