Créer un PDF à l'enregistrement du Exel
RésoluDavid512 -
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,
50 réponses
- 1
- 2
- 3
La problématique porte sur l’enregistrement automatique d’un fichier Excel au format PDF lors de la sauvegarde, notamment sous Office 2010 sous Windows 7. Plusieurs solutions apparaissent, notamment l’utilisation d’un macro dans ThisWorkbook_BeforeSave qui appelle ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF et génère le PDF à l’emplacement et sous le nom souhaités. Des variantes permettent de composer le dossier cible par référence, feuille et contenu, avec des chemins et noms dynamiques, mais nécessitent d’adapter le code pour les répertoires et la structuration des dossiers. En cas d’erreur, il peut être nécessaire d’utiliser des chemins complets et des droits d’écriture adaptés, ou d’activer les autorisations réseau, afin d’éviter les échecs d’export lors de la sauvegarde.
-
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 -
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 -
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 -
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 -
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+ -
Re,
prendre version de 15:19
dans la precedente il y a un x en trop devant Workbook_BeforeSave.... -
-
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, -
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 !!!
-
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 ....... -
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, -
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 -
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é -
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
- 1
- 2
- 3