Macro enregistrement pdf dossier spécifique

Question

Bonjour,

J'ai une macro qui me permet de faire un PDF d'une plage prédéfinie et de l'enregistrer dans un dossier prévu pour. Puis d'actualiser cette plage à l'aide d'un menu déroulant et de répéter l'opération.

Elle marche très bien, j'aimerai juste pousser le bouchon plus loin en lui demandant quand elle enregistre un fichier avec nom = CCM par exemple, alors elle cherche si il y a un dossier qui a le même nom, si oui elle l'enregistre dedans, sinon elle le crée et l'enregistre dedans.

Je suis pas expert, je bidouille juste quelques trucs et je suis arrivé à cela, et depuis je bloque, mon MkDir ne marche pas.

Pouvez-vous m'aider svp ?

Sub Impression_PDF_Janvier()

Dim cell As Range
For Each cell In Range("TRANSPORTEUR")
Range("LISTE1").Value = cell
Application.Run ("pdf_janvier")
Next cell
MsgBox ("Terminé")
End Sub

Sub pdf_janvier()

Sheets("Edition transporteurs").Select
Dim GestionFichier As New Scripting.FileSystemObject
' On commence par définir une variable de type Folder :
Dim Dossier As Folder, res As String, CodeTPT As String, chemin As String
Dim Creation As String
Dim Mon_Transporteur As String
Mon_Transporteur = Range("LISTE1").Value
Application.Goto Reference:="SUIVI1"
CodeTPT = ActiveSheet.Range("G260")
nomTPT = ActiveSheet.Range("I260").Value
nomfichier = CodeTPT & "-" & nomTPT & ".pdf"
chemin = "C:\Users\mb\Test"

' Cette boucle parcourt tous les dossiers
For Each Dossier In GestionFichier.GetFolder(chemin).SubFolders
res = Left(Dossier.Name, CodeTPT)
If res = CodeTPT Then

Selection.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
nomfichier & ".pdf", Quality:= _
xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
From:=1, To:=1, OpenAfterPublish:=False _

Set GestionFichier = Nothing
Exit Sub
End If
Next
' si le dossier n'existe pas création
Creation = chemin & CodeTPT & " - " & nomTPT & "\"
MkDir (Creation)
Set GestionFichier = Nothing
End If

End Sub

Windows / Edge 108.0.1462.76

f894009 · Answer

Bonjour,

Pas de backslash ("\") en fin pour une creation repertoire

Fulerty · Answer

Bonjour,

Cela ne change absolument rien...

Est-ce que je suis clair sur ma demande ?

Merci.

f894009 · Answer

Re,

Mettez un point d'arret sur la ligne MkDir lancez le code et une fois a l'arret passez le curseur souris sur la variable Creation pour voir son contenu

Fulerty · Answer

Re, comme je vous ai dit je suis pas un expert du tout alors j'ai pas tout compris à ce que je dois faire là... désolé

f894009 · Answer

Re,

Point d'arret code:

Comment définir un point d'arrêt, Excel VBA (excelcorpo.com)

Fulerty · Answer

Re,

Ok ça marque mon chemin mais avec une modification, c'est venu ajouter le nom du dossier souhaité ?

Initialement : C:\Users\mb\Test

Et là :

C:\Users\mb\Testxxx -TPT

f894009 · Answer

Re,

Remettez un point d'arret sur la ligne MkDir, lancez

Une fois a l'arret, vous devez passer le curseur sur toutes les variables qui permettent d'arriver a creer le chemin complet

Vous verrez e qui coince

Fulerty · Answer

Re,

' Cette boucle parcourt tous les dossiers
For Each Dossier In GestionFichier.GetFolder(chemin).SubFolders
res = Left(Dossier.Name, CodeTPT)
If res = CodeTPT Then

Déjà, j'ai un doute là-dessus. Ca me marque res = 0 alors que je lui demande justement de chercher s'il y a un dossier qui commence par le CodeTPT, non ? Je l'ai mal formulé ?

Ensuite, j'ai l'impression que dans ma définition de création :

Creation = chemin & CodeTPT & " - " & nomTPT & "\"

Le slash de fin n'est pas pris en compte, pourquoi ?

Merci pour votre aide

f894009 · Answer

Re,

Le slash de fin n'est pas pris en compte, pourquoi ?

Vous creez un repertoire et y a pas de backslash en bout du nom de repertoire

Par contre pour chemin, il en faut un a la fin:

chemin = "C:\Users\mb\Test\"

dossier qui commence par le CodeTPT

Sub pdf_janvier()
    Dim GestionFichier As New Scripting.FileSystemObject
    ' On commence par définir une variable de type Folder :
    Dim Dossier As Folder, res As String, CodeTPT As String, chemin As String
    Dim Creation As String
    Dim Mon_Transporteur As String
    
    With Worksheets("Edition transporteurs")
        Mon_Transporteur = .Range("LISTE1").Value
        Application.Goto Reference:="SUIVI1"
        CodeTPT = .Range("G260")
        nomTPT = .Range("I260").Value
    End With
    nomfichier = CodeTPT & "-" & nomTPT & ".pdf"
    chemin = "C:\Users\mb\Test\"

' Cette boucle parcourt tous les dossiers
    For Each Dossier In GestionFichier.GetFolder(chemin).SubFolders
        If Dossier.Name Like CodeTPT & "*" Then
            Selection.ExportAsFixedFormat Type:=xlTypePDF, Filename:=nomfichier & ".pdf", Quality:= _
            xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, from:=1, To:=1, OpenAfterPublish:=False
            Set GestionFichier = Nothing
            Exit Sub
        End If
    Next
    ' si le dossier n'existe pas création
    Creation = chemin & CodeTPT & " - " & nomTPT
    MkDir (Creation)
    Set GestionFichier = Nothing
End Sub

Fulerty · Answer

Re,

Alors là, la macro se lance bien, actualise en fonction du menu déroulant et prend bien la zone voulue, tourne de A à Z mais alors ça n'enregistre rien du tout.. ça ne fait ni dossier ni PDF.

Là je sèche ? Pourquoi ça ne fait aucun des deux ?

Fulerty · Answer

Même pour rentrer dans le détail, elle crée le 1er dossier correspondant au premier nom dans le menu déroulant mais elle fait rien d'autre, ni PDF dans le dossier ni création d'autres dossier, elle tourne dans le vide j'ai l'impression ?

f894009 · Answer

Re,

Ne faudrait-il pas trouver le moyen de faire une boucle ?

Ben, c'est vous qui savez si le nom est unique ou si vous voulez creer un dossier par nom de fichier dans la colonne G et ranger le fichier .pdf

Fulerty · Answer

Un dossier par nom dans la colonne G ! Mais je pensais justement que le début de ma macro permettait en gros de lancer à chaque fois cette macro là et qu’elle prendrait la nouvelle valeur dans g260 par exemple ?

f894009 · Answer

Bonjour,

Ben, si vous voulez que le code s'execute a chaque changement de nom dans une des cellules de la colonne G, il faut passer par les evenements VBA feuille en reprenant votre code pour la creation

Si vous le voulez je vous fais un fichier exemple

Fulerty · Answer

Bonjour,

Je suis arrivé à ce point :

Sub Impression_PDF_Aout()

Dim cell As Range
For Each cell In Range("TRANSPORTEUR")
 Range("LISTE8").Value = cell
 Application.Run ("pdf_aout")
Next cell
MsgBox ("Terminé")
End Sub

Sub pdf_aout()
 Dim FolderPath$, Nom As String, CodeTPT As String
 Dim Mon_Fournisseur As String
Mon_Fournisseur = Range("LISTE8").Value
Application.Goto Reference:="SUIVI8"
 nomTPT = ActiveSheet.Range("LISTE8").Value
 CodeTPT = ActiveSheet.Range("CODE8").Value
nomFichier = nomTPT & "-" & CodeTPT & "-" & "Indicateur Aout"
FolderPath = "C:\Users\mb	est" & nomTPT & "-" & CodeTPT
If Dir(FolderPath, vbDirectory) = "" Then
        MkDir FolderPath
        ChDir FolderPath
        Else
        Selection.ExportAsFixedFormat Type:=xlTypePDF, Filename:=nomFichier & ".pdf", Quality:= _
xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
from:=1, To:=1, OpenAfterPublish:=False _

End If
End Sub

Tout se passe nickel. La création du dossier se fait bien, l'enregistrement se fait bien dedans et les noms sont bons. Parcontre, quand le dossier existe déjà, l'enregistrement ne se fait pas.

J'ai essayé par exemple de modifier le nom du fichier pour voir s'il s'enregistre bien mais rien n'y fait. J'imagine que je me suis planté de sens quelque part vers mon ' If dir ' ?

Merci d'avance.

Fulerty · Answer

Rectification : Si je la relance une deuxième fois en changeant le nom du fichier, tous les fichiers pdf (150 exemplaires) s'enregistrent dans le dernier dossier crée.. je ne sais pas pourquoi.

J'ai l'impression d'être si proche du but et en même temps si loin...

f894009 · Answer

Re,

Dans votre code sub pdf_aout, si repertoire existe pas, creation repretoire mais pas d'enregistrement

c'est quoi ce truc: Application.Goto Reference:="SUIVI8"

Pourquoi les 1 de code1 etc se sont transformes en 8?

Fulerty · Answer

Re,

Car enfait j'ai une macro par mois sur ce gros fichier, j'ai fait des tests sur chaque mois et voilà pourquoi c'est code8.

Application.Goto Reference:="SUIVI8" -> cette ligne me permet de sélectionner la plage de données que je veux imprimer, ça marche très bien comme ça mon PDF ressort très bien.

Dans mon code actuel, si le répertoire existe pas, création répertoire ET enregistrement, à contrario si le répertoire existe, pas d'enregistrement je sais pas pourquoi..

Comme je vous ai dis, en creusant, lors de la deuxième exécution, tous mes fichiers PDF vont s'imprimer dans le dernier dossier crée si tous les dossiers sont déjà existants.

Je bloque

f894009 · Answer

Re,

création répertoire ET enregistrement

Si c'est le code au dessus, faux

If Dir(FolderPath, vbDirectory) = "" Then     'creation si existe pas, pas d'enregistrement
        MkDir FolderPath
        ChDir FolderPath
Else    'existe donc enregistrement
        Selection.ExportAsFixedFormat Type:=xlTypePDF, Filename:=nomFichier & ".pdf", Quality:= _
        xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
        from:=1, To:=1, OpenAfterPublish:=False
End If

Fulerty · Answer

Re,

Quelle est la différence avec mon code ? Je veux un enregistrement dans tous les cas, qu'il y ai le dossier ou non :(

Fulerty · Answer

Re,

C'est mon code actuellement utilisé. Il marche ! Il crée les dossiers s'ils n'existent pas, puis enregistre dedans. C'est top.

Ce qui marche pas, c'est quand le dossier existe déjà, là ça bug et ça ne fait pas l'enregistrement dans le dossier souhaité.

Je ne suis peut-être pas clair

f894009 · Answer

Re,

Je suis desole mais ca confirme ce que je vous ai dit

Si le repertoire existe vous ne n'avez pas le ChDir du repertoire existant qu'il y a si le repertoire n'existe pas

If Dir(FolderPath, vbDirectory) = "" Then     'creation si existe pas, pas d'enregistrement
        MkDir FolderPath
        ChDir FolderPath
Else    'existe donc enregistrement
        Selection.ExportAsFixedFormat Type:=xlTypePDF, Filename:=nomFichier & ".pdf", Quality:= _
        xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
        from:=1, To:=1, OpenAfterPublish:=False
End If

Par contre, normalement il est possible de mettre le chemin complet avec le nom du fichier pour Filename:= et plus besoin de CHDir

Fulerty · Answer

C'est à dire ? COmment corriger cela ?

Fulerty · Answer

Waouh, la première marche à la perfection. La deuxième quant à elle me fait une erreur 1004 et ne parvient pas à enregistrer le PDF. Mais la première marche !!!!

Merci beaucoup beaucoup pour votre temps et votre patience :D C'est trop bien !

Fulerty · Answer

Bonjour,

Je l'essaierai lundi ou mardi.

En tout cas, la première version marche à merveille, j'ai adapté celle-ci à d'autres macros et tous mes fichiers viennent dans le dossier et c'est merveilleux ! Sur une si grosse quantité de fichier et dossier à générer, le gain de temps est énorme.

Merci beaucoup!

Macro enregistrement pdf dossier spécifique - Page 2

Newsletters