Créer un PDF à l'enregistrement du Exel

Résolu/Fermé

David512 - 28 mars 2012 à 13:18
David512 - 5 avril 2012 à 09:01

Bonjour,

Je voudrai savoir s'il est possible de générer un fichier PDF à l'enregistrement de mon fichier exel en automatique ??

Car je voudrai éviter de passer par "enregistrer sous PDF" ou encore "PDF Créator" etc.

J'utilise Office 2010

Merci,

A voir également:

Exportasfixedformat type:=xltypepdf
Créer un compte gmail - Guide
Créer un compte google - Guide
Comment creer un pdf - Guide
Lire le coran en français pdf - Télécharger - Histoire & Religion
Créer un groupe whatsapp - Guide

50 réponses

Réponse 1 / 50

f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024 1 702
Modifié par f894009 le 28/03/2012 à 13:46

Re,Code a copier dans VBA---->ThisWorkbook

Ouvrir VBA par Alt+F11
Double click gauche sur ThisWorbook en haut a gauche
Click gauche sur fenetre a droite

Copier le code

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
'Changer le chemin et le nom du fichier
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"D:\_Docs_Prog_Excel\filtre_2003.pdf", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
True

End Sub

Réponse 2 / 50

f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024 1 702
3 avril 2012 à 14:29

Re,

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Reference = Worksheets("FPI - Fiche").Range("W2")
Nom_Fichier_PDF = Worksheets("FPI - Fiche").Range("W4")

'repertoire
If Len(Reference) > 6 Then
NbCarrep = 2
NbCarsousrep = 5
Else
NbCarrep = 1
NbCarsousrep = 4
End If
rep = "Z:\Diffusion_Plans\PDF\FPI\" & Left(Reference, NbCarrep) & "\"
'sous-repertoire
Sous_rep = Left(Reference, NbCarsousrep) & "00-" & Left(Reference, NbCarsousrep) & "99" & "\"

Nom_Fichier = Nom_Fichier_PDF & ".PDF"
strCheminComplet = rep & Sous_rep & Sous_Sous_rep & Nom_Fichier

'sauvegarde en PDF
Worksheets("FPI - Fiche").Activate
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=strCheminComplet _
, Quality:=xlQualityStandard, includeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=True
End Sub

Réponse 3 / 50

f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024 1 702
28 mars 2012 à 13:38

Bonjour,
Code a copier dans VBA---->ThisWorkbook

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
'Changer le chemin et le nom du fichier
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"D:\_Docs_Prog_Excel\filtre_2003.pdf", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
True

End Sub

Réponse 4 / 50

f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024 1 702
29 mars 2012 à 09:19

Bonjour,

dois-je fermer la fenetre ou modifier: 'changer le chemin et le nom du fichier ou autre chose ???

Vous devez remplacer:
"D:\_Docs_Prog_Excel\filtre_2003.pdf"

par le chemin et le nom de votre fichier ex: "C:\nomrepertoire\nomfichier.pdf"

ensuite vous fermez la fenetre VBA et faite le test en fermant votre fichier.

A+

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question

Réponse 5 / 50

f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024 1 702
3 avril 2012 à 10:36

Re,

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
'Nom de la feuille a changer si pas feuil1
Reference = Worksheets("feuil1").Range("W2")
Nom_Fichier_PDF = Worksheets("feuil1").Range("W4")

'repertoire
rep = "Z:\Diffusion_Plans\PDF\FPI\" & Left(Reference, 1) & "\"
'sous-repertoire
Sous_rep = Left(Reference, 4) & "00-" & Left(Reference, 4) & "99" & "\"
'sous-sous-repertoire
Sous_Sous_rep = Reference & "\"

Nom_Fichier = Nom_Fichier_PDF & ".PDF"
strCheminComplet = rep & Sous_rep & Sous_Sous_rep & Nom_Fichier

'sauvegarde eb PDF
ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, Filename:=strCheminComplet _
, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=True
End Sub

A+

Réponse 6 / 50

f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024 1 702
3 avril 2012 à 15:30

Re,

prendre version de 15:19
dans la precedente il y a un x en trop devant Workbook_BeforeSave....

Réponse 7 / 50

David512
28 mars 2012 à 13:39

Puis-je avoir + de détail (tutoriel) car je suis novice en la matiére !!!!

Merci,

Réponse 8 / 50

David512
29 mars 2012 à 09:12

Re,

J'ai bien coller le code dans ThisWorkBook mais je ne sait pas quoi faire par la suite...

dois-je fermer la fenetre ou modifier: 'changer le chemin et le nom du fichier ou autre chose ???

merci de m'aiguiller car je ne connait aucunement VBA

Réponse 9 / 50

David512
29 mars 2012 à 13:37

Un grand merci, cela fonctionne trés bien !!

Maintenant il y a un petite subtilitée:
Le code décrit un emplacement bien spécifique. Moi je voudrai pouvoir l'enregistrer dans plusieurs dossiers !!!
Je m'explique:
Dés que j'ouvre un nouveau fichier excel et que je l'enregistre sous par exemple:

"A28658" je voudrai qu'il soit enregistré dans un dossier C:\A\A28600-A28700
Le nom de mon fichier A28658 doit se trouver dans le dossier A28600-A28700 car il est compris entre A28600 et A28700.

"B52369" je voudrai qu'il soit enregistré dans un dossier C:\B\B52300-B52400
Le nom de mon fichier B52369 doit se trouver dans le dossier B52300-B52400 car il est compris entre B52300 et B52400.

"Z00069" je voudrai qu'il soit enregistré dans un dossier C:\Z\Z00000-Z00100
Le nom de mon fichier Z00069 doit se trouver dans le dossier Z00000-Z00100 car il est compris entre B52300 et B52400.

etc...

J'espére que c'est faisable !!!

Merci d'avance,

Réponse 10 / 50

f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024 1 702
29 mars 2012 à 13:45

Re,

"A28710" pourrait exister???

Réponse 11 / 50

David512
29 mars 2012 à 13:50

Oui et je voudrai qu'il soit enregistré dans un dossier C:\A\A28700-A28800
Le nom de mon fichier A28710 doit se trouver dans le dossier A28700-A28800 car il est compris entre A28700 et A28800.

Tout comme autre références...

Réponse 12 / 50

David512
29 mars 2012 à 13:52

Par la même occasion le nom de fichier générer en PDF doit avoir le même nom que le fichier excel !!!

Réponse 13 / 50

f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024 1 702
29 mars 2012 à 16:02

Re,

Pour facilite et qui serait plus logique, il faudrait faire des repertoires:
C:\A\A28600---->de 600 a 699
C:\A\A28700---->de 700 a 799
C:\A\A28800---->de 800 a 899

et .......

Réponse 14 / 50

f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024 1 702
29 mars 2012 à 16:23

Re

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
'repertoire
rep = "C:\" & Left(ThisWorkbook.Name, 1)
'sous-repertoire
Sous_rep = Left(fichier_test, 4) & "00"
Nom_Fichier = Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 5)
strCheminComplet = rep & "\" & Sous_rep & "\" & Nom_Fichier & ".PDF"
'sauvegarde eb PDF et xlsx
ActiveWorkbook.SaveAs Filename:=strCheminComplet, _
FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
Range("B25").Select
ActiveWorkbook.Save
Application.WindowState = xlMinimized
End Sub

A essayer

Réponse 15 / 50

David512
30 mars 2012 à 09:21

Re

Je ne peut pas faire de répertoire C:\A\A28600---->de 600 a 699 car j'ai déjà des références C:\A\A600---->de 600 a 699

Par contre ce que je peut faire :

"A28658" je voudrai qu'il soit enregistré dans un dossier C:\A\A28600-A28699
Le nom de mon fichier A28658 doit se trouver dans le dossier A28600-A28699 car il est compris entre A28600 et A28699.

"B52369" je voudrai qu'il soit enregistré dans un dossier C:\B\B52300-B52399
Le nom de mon fichier B52369 doit se trouver dans le dossier B52300-B52399 car il est compris entre B52300 et B52399.

"Z00069" je voudrai qu'il soit enregistré dans un dossier C:\Z\Z00000-Z00099
Le nom de mon fichier Z00069 doit se trouver dans le dossier Z00000-Z00099 car il est compris entre Z00000 et Z00099.

Si ça arrange !!!

Pour le dernier code, me dire ce qu'il faut remplacer comme texte !!

Merci d'avance,

Réponse 16 / 50

f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024 1 702
Modifié par f894009 le 30/03/2012 à 11:46

Bonjour,

Je ne peut pas faire de répertoire C:\A\A28600---->de 600 a 699 car j'ai déjà des références C:\A\A600---->de 600 a 699.

Nous nous sommes mal compris.

C:\A\A28600---->de A28600 a A28699.

et pourquoi C:\B\B52300-B52399 ce qui est en de 300 a 399 est forcement dans le repertoire C:\B\B52300 alors simplifiez.

Dans le code ci-dessous, les repertoires sont : C:\A\A28600 .......
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
'repertoire
rep = "C:\" & Left(ThisWorkbook.Name, 1)
'sous-repertoire
Sous_rep = Left(fichier_test, 4) & "00"
Nom_Fichier = Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 5)
strCheminComplet = rep & "\" & Sous_rep & "\" & Nom_Fichier & ".PDF"
'sauvegarde eb PDF et xlsx
ActiveWorkbook.SaveAs Filename:=strCheminComplet, _
FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
Range("B25").Select
ActiveWorkbook.Save
Application.WindowState = xlMinimized
End Sub

Il n'y a rien a remplacer

Réponse 17 / 50

David512
30 mars 2012 à 13:49

Au niveau des répertoires ce sont des dossiers qui ont été créer il y a pas mal d'année et vue le nombre qu'il y a je ne peut pas me permettre de tout modifier...

Je doit donc rester dans cette config de classement...

l'exemple que j'ai donné était : C:\A\A28600-A28699 pour faire simple

mais en réalité j'aurai dû être plus précis:
il s'agit: P:\nomrépertoire\nomrépertoire\nomrépertoire\nomrépertoire\nomrépertoire\nomrépertoire\nomfichier.pdf

ce qui correspond à:
P:\etude\Plan\Fiche\A\A28600-A28699\nomfichier.pdf

Réponse 18 / 50

f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024 1 702
Modifié par f894009 le 30/03/2012 à 15:58

Re,

Code avec ce que vous avez demander.

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
'repertoire
rep = "P:\etude\Plan\Fiche\" & Left(ThisWorkbook.Name, 1)
'sous-repertoire
Sous_rep = Left(fichier_test, 4) & "00-" & Left(fichier_test, 4) & "99"
Nom_Fichier = Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 5)
strCheminComplet = rep & "\" & Sous_rep & "\" & Nom_Fichier & ".PDF"
'sauvegarde eb PDF et xlsx
ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, Filename:=strCheminComplet _
, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=True
ActiveWorkbook.Save
End Sub

Bonne suite

Réponse 19 / 50

David512
30 mars 2012 à 16:01

En enregistrant mon fichier excel j'obtient un message d'erreur:

Erreur d'exécution '1004':
La méthode 'saveAs' de l'objet'_Workbook' a échoué

Réponse 20 / 50

f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024 1 702
30 mars 2012 à 16:05

Re,

J'ai mis une autre version entre temps.

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
'repertoire
rep = "P:\etude\Plan\Fiche\" & Left(ThisWorkbook.Name, 1)
'sous-repertoire
Sous_rep = Left(fichier_test, 4) & "00-" & Left(fichier_test, 4) & "99"
Nom_Fichier = Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 5)
strCheminComplet = rep & "\" & Sous_rep & "\" & Nom_Fichier & ".PDF"
'sauvegarde eb PDF et xlsx
ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, Filename:=strCheminComplet _
, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=True
ActiveWorkbook.Save
End Sub

Newsletters