Création PDF en Boucle
Bonjour,
Je souhaite créer une boucle qui fera un PDF pour chaque nom de ma grille.
Chaque PDF devra aller se déposer dans un répertoire au nom de l'onglet correspondant et au nom de la personne.
Les titres A2:F2 devrait être répété.
Ensuite, un PDF avec A3:F7, un autre A8:F12, ainsi de suite jusqu'à tomber sur une cellule vide en A.
J'ai déjà une macro qui fonctionne pour créer un PDF et des répertoires. Par contre, je ne sais pas comment l'adapter pour mon cas.
Voici ma macro initial:
Sub CreationPDF()
Dim FolderPath As String, count As Integer
'Copie le chemin du dossier d'impression
Path = "G:\VPVSC\Partage\Rapports et statistiques\Gestion de la performance\Intégration affaires\Prépopulation"
Path_DS = Path & "\" & Sheets("Prepop").Range("D13").Value
Path_agent = Path_DS & "\" & Sheets("Prepop").Range("D12").Value
FolderPath = Path_agent & "\*.pdf"
'Créer les dossier s'ils n'existent pas
Set fs = CreateObject("Scripting.FileSystemObject")
If Not fs.FolderExists(Path) Then
fs.createfolder (Path)
End If
If Not fs.FolderExists(Path_DS) Then
fs.createfolder (Path_DS)
End If
If Not fs.FolderExists(Path_agent) Then
fs.createfolder (Path_agent)
End If
Filename = Dir(FolderPath)
Do While Filename <> ""
count = count + 1
Filename = Dir()
Loop
nouveauFichier = Path_agent & "\Agent- " & Sheets("Prepop").Range("d12").Value & "- " & Sheets("Prepop").Range("L7").Value & "- " & count & ".pdf"
'On enregistre le fichier excel en .pdf
Sheets(Array("Prepop", "Résultats")).Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=nouveauFichier, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
Sheets("ANALYSIS").Activate
Sheets("Prepop").Activate
SendKeys "{Escape}"
End Sub
Est-ce que quelqu'un aurait des suggestions pour m'aider?
Merci
Bon,jour,
un essai
les fichiers seront stockés sur ton bureau ... reste à adapter le dossier (je te laisse la main)
Sub produire_pdf()
onglet = "Nom gestionnaire"
Sheets("pdf").Select
Sheets("pdf").[A3].Select
i = 3
Do While Sheets(onglet).Cells(i, 1) <> ""
Sheets(onglet).Select
Rows(i & ":" & i + 4).Select
Selection.Copy
Sheets("pdf").Select
ActiveSheet.Paste
nompdf = Environ("USERPROFILE") & "\Desktop\" & Sheets(onglet).Cells(i, 1)
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=nompdf & ".pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
i = i + 5
Loop
Sheets(onglet).Select
End Sub
avec création du répertoire au nom de lo'nglet
directement sous ton USER ... tu peux modifier cette instruction Environ("USERPROFILE")
Sub produire_pdf()
onglet = "Nom gestionnaire"
Sheets("pdf").Select
Sheets("pdf").[A3].Select
i = 3
Do While Sheets(onglet).Cells(i, 1) <> ""
Sheets(onglet).Select
Rows(i & ":" & i + 4).Select
Selection.Copy
Sheets("pdf").Select
ActiveSheet.Paste
creation Environ("USERPROFILE") & "\" & onglet
nompdf = Environ("USERPROFILE") & "\" & onglet & "\" & Sheets(onglet).Cells(i, 1)
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=nompdf & ".pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
i = i + 5
Loop
Sheets(onglet).Select
End Sub
Sub creation(repertoire As String)
Dim fso As Object
Dim rep As String
Dim tabrep, i%
rep = ""
Set fso = CreateObject("Scripting.FileSystemObject")
tabrep = Split(repertoire, "\")
For i = 1 To UBound(tabrep)
rep = rep & "\" & tabrep(i)
If Dir(rep, vbDirectory) = "" Then
nbdir = nbdir + 1
fso.CreateFolder rep
End If
Next i
End Sub
Merci Steelson pour ta réponse.
J'ai fait le test et j'ai erreur d'exécution 70. Sais-tu comment je pourrais corriger ça ?
Aussi, que veux-tu dire par: peux modifier cette instruction Environ("USERPROFILE") ?
Si je veux créer les PDF ici : "G:\VPVSC\Partage\Rapports et statistiques\Gestion de la performance\" est-ce que je dois remplacer Environ("USERPROFILE" par mon lien ?
Merci de ton aide!
benibeno a écrit :J'ai fait le test et j'ai erreur d'exécution 70. Sais-tu comment je pourrais corriger ça ?
/quote]
= permission d'accès refusée ... donc on passe au point suivant qui devrait résoudre
benibeno a écrit :Si je veux créer les PDF ici : "G:\VPVSC\Partage\Rapports et statistiques\Gestion de la performance\" est-ce que je dois remplacer Environ("USERPROFILE" par mon lien ?
OUI, mais sans le dernier \ (je vérifie)
creation "G:\VPVSC\Partage\Rapports et statistiques\Gestion de la performance\" & onglet
nompdf = "G:\VPVSC\Partage\Rapports et statistiques\Gestion de la performance\" & onglet & "\" & Sheets(onglet).Cells(i, 1)
Merci pour tes réponses!
Ça fonctionne bien
Finalement, après avoir rouler à nouveau la macro j'ai encore le même problème.
J'ai essayer d'autres répertoires, mais sans succès. Bizarrement mon code poster plus haut qui créer également des dossier et des PDF fonctionne et il utilise le même principe sans la boucle.
J'ai mis en rouge la partie qui plante:
Sub produire_pdf()
Dim onglet As String
onglet = ActiveSheet.Name
Application.ScreenUpdating = False
Sheets("pdf").Select
Sheets("pdf").[A3].Select
i = 3
Do While Sheets(onglet).Cells(i, 1) <> ""
Sheets(onglet).Select
Rows(i & ":" & i + 4).Select
Selection.Copy
Sheets("pdf").Select
ActiveSheet.Paste
creation "G:\VPVSC\DP Expérience client\DPV\Dossiers Benoit Faucher\" & onglet
nompdf = "G:\VPVSC\DP Expérience client\DPV\Dossiers Benoit Faucher\" & onglet & "\" & Sheets(onglet).Cells(i, 1)
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=nompdf & ".pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
i = i + 5
Loop
Sheets(onglet).Select
Application.ScreenUpdating = True
End Sub
Sub creation(repertoire As String)
Dim fso As Scripting.FileSystemObject
Dim rep As String
Dim tabrep, i%
rep = ""
Set fso = New Scripting.FileSystemObject
tabrep = Split(repertoire, "\")
For i = 1 To UBound(tabrep)
rep = rep & "\" & tabrep(i)
If Dir(rep, vbDirectory) = "" Then
nbdir = nbdir + 1
fso.CreateFolder rep
End If
Next i
End Sub
Est-ce possible de contourner le problème ?
Merci !
Quel est le nom de l'onglet ? ... onglet = ActiveSheet.Name
C'est le nom du gestionnaire (il pourrait différer dans le temps).
De cette façon ça semble fonctionner, mais je dois créer au préalable les dossiers.
Sub produire_pdf()
Dim onglet As String
onglet = "HALLEE, MELANIE"
Application.ScreenUpdating = False
Sheets("pdf").Select
Sheets("pdf").[A3].Select
i = 3
Do While Sheets(onglet).Cells(i, 1) <> ""
Sheets(onglet).Select
Rows(i & ":" & i + 4).Select
Selection.Copy
Sheets("pdf").Select
ActiveSheet.Paste
nompdf = "G:\VPVSC\DP Expérience client\DPV\Dossiers Benoit Faucher\" & onglet & "\" & Sheets(onglet).Cells(i, 1)
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=nompdf & ".pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
i = i + 5
Loop
Sheets(onglet).Select
Application.ScreenUpdating = True
End Sub
Merci pour ton aide.
ok mais la question que je me pose : y-a-t il des caractères interdits ? essaie de créer un dossier "à la main" directement sous l'explorateur avec ce nom pour voir ...