Erreur d'execution 429... Veut enregistrer en pdf
Bonjour,
Je sais enregistrer un pdf simplement avec le "code 1".
Cependant je souhaite maintenant faire une incrémentation si le pdf existe déjà dans le dossier (je ne veux pas l'ecraser !)
Je souhaite utiliser le "code 2" mais j'ai une erreur 429 qui me dit un composant activeX ne peut pas créer d'objet..
La ligne pointé est surlignée... je ne suis pas assez balaise en VBA pour trouver
Help please.
D'avance, merci.
Sub EnregistrerBL2222() CODE 1
'Déclaration des variables
Dim NomDossier As String
Dim CheminDossier As String
On Error GoTo 1
'Nom de dossier
NomDossier = [C4]
CheminDossier = "C:\Users\Alexis\Documents\2017\" & NomDossier & "\"
If NomDossier = "" Then Exit Sub
'Enregistrement au format pdf
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
CheminDossier & "BL_" & Range("C4").Value & ".pdf", quality:= _
xlQualityStandard, includedocproperties:=True, ignoreprintareas:=False, _
from:=1, to:=1, openafterpublish:=False
1
'Impression de 2 exemplaires
'Sheets("BL").PrintOut , , 2
End Sub
CODE 2
Private Function RenommerFichier(CheminDossier As String, NomDossier As String) As String
Dim i As Long
Dim FSO As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
If FSO.fileExists(CheminDossier & "\" & NomDossier & ".pdf") = True Then
sNouveauNom = NomDossier
i = 0
While FSO.fileExists(CheminDossier & "\" & sNouveauNom & ".pdf") = True
i = i + 1
sNouveauNom = NomDossier & Chr(40) & Format(i, "000") & Chr(41)
Wend
NomDossier = sNouveauNom
End If
Set FSO = Nothing
RenommerFichier = NomDossier
End Function
Sub PDFCREATION()
Dim JobPDF As Object
Dim sNomPDF As String
Dim sCheminPDF As String
Dim sNouveauNomPDF As String
Dim FSO As Object
' le nom du PDF sans extension car PDFCreator l'ajoute ...
sNomPDF = [C4]
sCheminPDF = "C:\Users\Alexis\Documents\2017\" & NomDossier & "\"
Set FSO = CreateObject("Scripting.FileSystemObject")
If Not FSO.FolderExists(sCheminPDF) Then FSO.CreateFolder (sCheminPDF)
Set FSO = Nothing
sNouveauNomPDF = RenommerFichier(sCheminPDF, sNomPDF)
Set JobPDF = CreateObject("PDFCreator.clsPDFCreator")
With JobPDF
.cStart "/NoProcessingAtStartup"
.cOption("UseAutosave") = 1
.cOption("UseAutosaveDirectory") = 1
.cOption("AutosaveDirectory") = sCheminPDF
.cOption("AutosaveFilename") = sNouveauNomPDF
.cOption("AutosaveStartStandardProgram") = 0
.cOption("UpdateInterval") = 0
.cOption("AutosaveFormat") = 0
.cClearCache
End With
ActiveSheet.PrintOut copies:=1, ActivePrinter:="PDFCreator"
Do Until JobPDF.cCountOfPrintjobs = 1
DoEvents
Loop
JobPDF.cPrinterStop = False
Do Until JobPDF.cCountOfPrintjobs = 0
DoEvents
Loop
JobPDF.cClose
Set JobPDF = Nothing
End Sub
Bonsoir,
Pourquoi vouloir utiliser PDFCreator avec Excel 2016 !
Tu arranges ta procédure 1 pour utiliser ta fonction.
Bonsoir,
Merci pour ta réponse
Etant totalement débutant en VBA... Peux-tu m'aiguiller un peu stp ..
Merci à toi.
Cdlt
Alex
J'ai essayé avec ça ..
Marche toujours pas..
Sub EnregistrerBL2222()
'Déclaration des variables
Dim NomDossier As String
Dim CheminDossier As String
On Error GoTo 1
'Nom de dossier
NomDossier = [C4]
CheminDossier = "C:\Users\Alexis\Documents\2017\" & NomDossier & "\"
If NomDossier = "" Then Exit Sub
Set FSO = CreateObject("Scripting.FileSystemObject")
If Not FSO.FolderExists(CheminDossier) Then FSO.CreateFolder (CheminDossier)
Set FSO = Nothing
sNouveauNom = RenommerFichier(CheminDossier, NomDossier)
'Enregistrement au format pdf
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
CheminDossier & "BL_" & Range("C4").Value & ".pdf", quality:= _
xlQualityStandard, includedocproperties:=True, ignoreprintareas:=False, _
from:=1, to:=1, openafterpublish:=False
1
'Impression de 2 exemplaires
'Sheets("BL").PrintOut , , 2
End Sub
Private Function RenommerFichier(CheminDossier As String, NomDossier As String) As String
Dim i As Long
Dim FSO As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
If FSO.fileExists(CheminDossier & "\" & NomDossier & ".pdf") = True Then
sNouveauNom = NomDossier
i = 0
While FSO.fileExists(CheminDossier & "\" & sNouveauNom & ".pdf") = True
i = i + 1
sNouveauNom = NomDossier & Chr(40) & Format(i, "000") & Chr(41)
Wend
NomDossier = sNouveauNom
End If
Set FSO = Nothing
RenommerFichier = NomDossier
End Function
Il y a un petit problème dans ta proc. !
CheminDossier indique le chemin, NomDossier est le nom du fichier sans l'extension.
Or tu ne l'utilises pas lors de l'enregistrement pdf d'une part, et tu viens flanquer au milieu un "BL_" !!!
Si cela fait partie du nom du fichier il faut l'inclure dans l'affectation à la variable !
NB- Il serait très appréciable que les balises Code soient utilisées systématiquement pour citer du code !
ça enregistre bien mon BL (Bon de Livraison) dans le dossier voulu mais si je ré enregistre par dessus ça écrase mon fichier comme avant
Mon incrémentation marche pas
Si tu répondais à la question, on avancerait !
Ah pardon, oui le "BL" fait bien parti du nom de fichier
Essayer :
Sub EnregistrerBL2222()
Dim NomDossier As String, CheminDossier As String
On Error GoTo 1
NomDossier = ActiveSheet.Range("C4")
If NomDossier = "" Then Exit Sub
CheminDossier = "C:\Users\Alexis\Documents\2017\" & NomDossier & "\"
NomDossier = RenommerFichier(CheminDossier, "BL_" & NomDossier)
ActiveSheet.ExportAsFixedFormat xlTypePDF, CheminDossier & NomDossier & ".pdf"
1:
End SubSous réserve de la cohérence de ton code où le nom de fichier (sans BL_) entre dans le chemin (est donc un sous-dossier)...
Bonsoir,
ça fonctionne, génial.
Oui le nom fichier est bien un sous dossier.
Merci encore pour votre aide.