Enregistrer un fichier en PDF dans 3 dossiers différents.
margaux1991
-
Patrice33740 Messages postés 8561 Date d'inscription Statut Membre Dernière intervention -
Patrice33740 Messages postés 8561 Date d'inscription Statut Membre Dernière intervention -
Bonjour,
J'ai un petit souci qui me tracasse et m'empêche d'avancer depuis bien 2h alors si vous avez des idées, n'hésitez pas !
Voilà, j'ai un fichier Excel qui me permet de créer une facture.
De ce fait, j'aimerai que cette facture se range à la fois dans un dossier qui classe les factures par mois et à la fois dans un dossier qui les classe par Prestataires.
Voilà le code...
Chemin = Workbooks(ActiveWorkbook.Name).Path
Feuille = ActiveSheet.Name
Dossier = "Etats de préfacturation"
DossierPresta = "Prefacturation par Prestataire"
DossierMois = "Préfacturation par Mois"
nomEvent = Range("E8")
nomPresta = Range("E6")
annee = Range("X5")
mois = Range("W5")
dateEvent = Range("Y5")
If Dir(Chemin & "\" & Dossier) = "" Then On Error Resume Next
MkDir Chemin & "\" & Dossier
' Enregistrement Dossier "par mois"
If Dir(Chemin & "\" & Dossier & "\" & DossierMois) = "" Then On Error Resume Next
MkDir Chemin & "\" & Dossier & "\" & DossierMois
If Dir(Chemin & "\" & Dossier & "\" & DossierMois & "\" & annee) = "" Then On Error Resume Next
MkDir Chemin & "\" & Dossier & "\" & DossierMois & "\" & annee
If Dir(Chemin & "\" & Dossier & "\" & DossierMois & "\" & annee & "\" & mois) = "" Then On Error Resume Next
MkDir Chemin & "\" & Dossier & "\" & DossierMois & "\" & annee & "\" & mois
If Dir(Chemin & "\" & Dossier & "\" & DossierMois & "\" & annee & "\" & mois & "\" & nomPresta) = "" Then On Error Resume Next
MkDir Chemin & "\" & Dossier & "\" & DossierMois & "\" & annee & "\" & mois & "\" & nomPresta
CheminMois = Chemin & " \ " & Dossier & " \ " & DossierMois & " \ " & annee & " \ " & mois & " \ " & nomPresta & " \ "
Sheets("Préfacturation par Prestataire").Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
CheminMois & nomEvent & " - " & dateEvent & " - " & nomPresta & ".pdf", Quality:= _
xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=False
' Enregistrement "par Prestataire"
If Dir(Chemin & "\" & Dossier & "\" & DossierPresta) = "" Then On Error Resume Next
MkDir Chemin & "\" & Dossier & "\" & DossierPresta
If Dir(Chemin & "\" & Dossier & "\" & DossierPresta & "\" & nomPresta) = "" Then On Error Resume Next
MkDir Chemin & "\" & Dossier & "\" & DossierPresta & "\" & nomPresta
If Dir(Chemin & "\" & Dossier & "\" & DossierPresta & "\" & nomPresta & "\" & annee) = "" Then On Error Resume Next
MkDir Chemin & "\" & Dossier & "\" & DossierPresta & "\" & nomPresta & "\" & annee
If Dir(Chemin & "\" & Dossier & "\" & DossierPresta & "\" & nomPresta & "\" & annee & "\" & mois) = "" Then On Error Resume Next
MkDir Chemin & "\" & Dossier & "\" & DossierPresta & "\" & nomPresta & "\" & annee & "\" & mois
CheminPresta = Chemin & " \ " & Dossier & " \ " & DossierPresta & " \ " & nomPresta & " \ " & annee & " \ " & mois & " \ "
Sheets("Préfacturation par Prestataire").Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
CheminPresta & nomEvent & " - " & dateEvent & " - " & nomPresta & ".pdf", Quality:= _
xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=False
End Sub
Quelqu'un voit l'erreur ?
Merci d'avance.
J'ai un petit souci qui me tracasse et m'empêche d'avancer depuis bien 2h alors si vous avez des idées, n'hésitez pas !
Voilà, j'ai un fichier Excel qui me permet de créer une facture.
De ce fait, j'aimerai que cette facture se range à la fois dans un dossier qui classe les factures par mois et à la fois dans un dossier qui les classe par Prestataires.
Voilà le code...
Chemin = Workbooks(ActiveWorkbook.Name).Path
Feuille = ActiveSheet.Name
Dossier = "Etats de préfacturation"
DossierPresta = "Prefacturation par Prestataire"
DossierMois = "Préfacturation par Mois"
nomEvent = Range("E8")
nomPresta = Range("E6")
annee = Range("X5")
mois = Range("W5")
dateEvent = Range("Y5")
If Dir(Chemin & "\" & Dossier) = "" Then On Error Resume Next
MkDir Chemin & "\" & Dossier
' Enregistrement Dossier "par mois"
If Dir(Chemin & "\" & Dossier & "\" & DossierMois) = "" Then On Error Resume Next
MkDir Chemin & "\" & Dossier & "\" & DossierMois
If Dir(Chemin & "\" & Dossier & "\" & DossierMois & "\" & annee) = "" Then On Error Resume Next
MkDir Chemin & "\" & Dossier & "\" & DossierMois & "\" & annee
If Dir(Chemin & "\" & Dossier & "\" & DossierMois & "\" & annee & "\" & mois) = "" Then On Error Resume Next
MkDir Chemin & "\" & Dossier & "\" & DossierMois & "\" & annee & "\" & mois
If Dir(Chemin & "\" & Dossier & "\" & DossierMois & "\" & annee & "\" & mois & "\" & nomPresta) = "" Then On Error Resume Next
MkDir Chemin & "\" & Dossier & "\" & DossierMois & "\" & annee & "\" & mois & "\" & nomPresta
CheminMois = Chemin & " \ " & Dossier & " \ " & DossierMois & " \ " & annee & " \ " & mois & " \ " & nomPresta & " \ "
Sheets("Préfacturation par Prestataire").Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
CheminMois & nomEvent & " - " & dateEvent & " - " & nomPresta & ".pdf", Quality:= _
xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=False
' Enregistrement "par Prestataire"
If Dir(Chemin & "\" & Dossier & "\" & DossierPresta) = "" Then On Error Resume Next
MkDir Chemin & "\" & Dossier & "\" & DossierPresta
If Dir(Chemin & "\" & Dossier & "\" & DossierPresta & "\" & nomPresta) = "" Then On Error Resume Next
MkDir Chemin & "\" & Dossier & "\" & DossierPresta & "\" & nomPresta
If Dir(Chemin & "\" & Dossier & "\" & DossierPresta & "\" & nomPresta & "\" & annee) = "" Then On Error Resume Next
MkDir Chemin & "\" & Dossier & "\" & DossierPresta & "\" & nomPresta & "\" & annee
If Dir(Chemin & "\" & Dossier & "\" & DossierPresta & "\" & nomPresta & "\" & annee & "\" & mois) = "" Then On Error Resume Next
MkDir Chemin & "\" & Dossier & "\" & DossierPresta & "\" & nomPresta & "\" & annee & "\" & mois
CheminPresta = Chemin & " \ " & Dossier & " \ " & DossierPresta & " \ " & nomPresta & " \ " & annee & " \ " & mois & " \ "
Sheets("Préfacturation par Prestataire").Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
CheminPresta & nomEvent & " - " & dateEvent & " - " & nomPresta & ".pdf", Quality:= _
xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=False
End Sub
Quelqu'un voit l'erreur ?
Merci d'avance.
A voir également:
- Enregistrer un fichier en PDF dans 3 dossiers différents.
- Lire le coran en français pdf - Télécharger - Histoire & Religion
- Fichier bin - Guide
- Comment réduire la taille d'un fichier - Guide
- Comment ouvrir un fichier epub ? - Guide
- Audacity enregistrer son pc - Guide
1 réponse
Bonjour,
Ma version Excel ne permet pas tester ton code mais :
Je trouve très cavalière ta méthode de création des répertoires manquants (sans rétablir la gestion d'erreur !), j'aurais plutôt écrit sous la forme :
Ma version Excel ne permet pas tester ton code mais :
Je trouve très cavalière ta méthode de création des répertoires manquants (sans rétablir la gestion d'erreur !), j'aurais plutôt écrit sous la forme :
If Dir(Chemin & "\" & Dossier) = "" Then On Error Resume Next MkDir Chemin & "\" & Dossier On Error GoTo 0 End Ifpour éviter de masquer d'autres erreurs !!!
Je viens de faire la modification mais cela ne change pas grand chose.
Les dossiers se créaient déjà et continuent de se créer comme il faut mais le fichier ne s'enregistre toujours pas...
Mon excel n'exporte pas au format pdf
A tout hasard, le nom du fichier ne contiendrait-il pas des caractères interdit ??? (par exemple des / dans dateEvent)
Pourquoi devrait-il y avoir un message d'erreur ?
Dans la date, j'ai fait attention que celle-ci soit avec un "." entre chaque..
"Erreur d'execution 5 : Argument ou appel de procédure incorrect." et VBA me surligne en jaune cette partie du code :
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
CheminEvent & "\" & nomFichier, Quality:= _
xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=False
Une idée ?
si ne fonctionne pas il devrait envoyer un message d'erreur (à condition d'avoir rétabli la gestion d'erreur avec les à chaque création de répertoire)