Créer un PDF à l'enregistrement du Exel [Résolu/Fermé]

Signaler
-
 David512 -
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:

50 réponses

Messages postés
15528
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
25 janvier 2021
1 439
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
2
Merci

Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire

CCM 63550 internautes nous ont dit merci ce mois-ci

Messages postés
15528
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
25 janvier 2021
1 439
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
2
Merci

Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire

CCM 63550 internautes nous ont dit merci ce mois-ci

Messages postés
15528
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
25 janvier 2021
1 439
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
Messages postés
15528
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
25 janvier 2021
1 439
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+
Messages postés
15528
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
25 janvier 2021
1 439
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+
Messages postés
15528
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
25 janvier 2021
1 439
Re,

prendre version de 15:19
dans la precedente il y a un x en trop devant Workbook_BeforeSave....
Puis-je avoir + de détail (tutoriel) car je suis novice en la matiére !!!!

Merci,
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
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,
Messages postés
15528
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
25 janvier 2021
1 439
Re,

"A28710" pourrait exister???
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...
Par la même occasion le nom de fichier générer en PDF doit avoir le même nom que le fichier excel !!!
Messages postés
15528
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
25 janvier 2021
1 439
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 .......
Messages postés
15528
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
25 janvier 2021
1 439
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
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,
Messages postés
15528
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
25 janvier 2021
1 439
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
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
Messages postés
15528
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
25 janvier 2021
1 439
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
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é
Messages postés
15528
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
25 janvier 2021
1 439
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