Boucle VBA - Exporter en PDF des fiches de salaire
Bonjour à tous !
Je viens vous demander de l'aide pour un tout nouveau fichier Excel qui me permet de sortir des fiches de salaire employés en fonction des heures obtenues sur une autre feuille nommée "Donnée"
J'aimerais pouvoir exporter mes fiches de salaire en PDF pour tous les employés. A savoir que, pour obtenir une fiche de salaire, je dois mettre le nom de l'employé en B1 dans ma feuille "Fiche de salaire"
Jusqu'ici, j'arrive à exporter les PDF un par un en modifiant à chaque fois le nom de l'employé mais j'aimerais un bouton qui me permette d'exporter un fichier PDF par employé pour tous les employés en une fois.
Il faudrait créer une boucle qui modifie automatique le nom de l'employé en B1 (feuille "fiche de salaire") en fonction d'une colonne (=Tableau1[Employé]) qui contient plusieurs fois les noms des employés. Je m'explique : Dans cette colonne figure par exemple :
Thomas, Thomas, Josiane, Josiane, Fred, Fred, Thomas. Il faudrait que la macro fasse : Thomas en B1, Export PDF, Josiane en B1, export PDF, Fred en B1, Export PDF. La boucle doit s'arrêter quand il ne reste plus d'employé.
Est-ce quelque chose de faisable ?
J’espère que vous pourrez m'aider à impressionner ma cheffe !
Voici le code que j'ai actuellement pour l'export d'un PDF à la fois :
Sub FICHE_DE_SALAIRE_export_pdf()
Dim fichier As String
'NOM DE LA FEUILLE :
With Worksheets("Fiche de salaire")
'NOM DU FICHIER PDF A ENREGISTRER
fichier = "\" & .Range("J17")
'NOM DU FICHIERS OÙ ENREGISTRER
Dossier = .Range("K19")
'CHEMIN OÙ ENREGISTRER LE FICHIER
rep = .Range("K20")
Chemin = rep & Dossier & fichier
'EXPORT PDF
.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Chemin, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
End With
End Sub
bonjour,
essaie ceci (ne fonctionne pas sur MAC)
Sub aargh()
Set dictnom = CreateObject("scripting.dictionary")
tabnom = Sheets("données").ListObjects("table1").ListColumns(1).DataBodyRange
For i = LBound(tabnom) To UBound(tabnom)
If Not dictnom.exists(tabnom(i, 1)) Then
dictnom.Add tabnom(i, 1), 1
Worksheets("Fiche de salaire").Range("B1") = tabnom(i, 1)
fiche_de_salaire_export_pdf
End If
Next i
End Sub
J'ai essayé mais ça n'a pas fonctionné...
Il faut savoir que la colonne qui comporte les nom d'employé sont dans la feuille "Donnée" dans le Tableau1 ; colonne du tableau "Employé" (Elle se trouve en $G$2:$G9999 (Indéfini)
Est-ce bien comme cela : ?
Sub FICHE_DE_SALAIRE_Export_pdf_2()
Set dictnom = CreateObject("scripting.dictionary")
tabnom = Sheets("données").ListObjects("table1").ListColumns(1).DataBodyRange
For i = LBound(tabnom) To UBound(tabnom)
If Not dictnom.exists(tabnom(i, 1)) Then
dictnom.Add tabnom(i, 1), 1
Worksheets("Fiche de salaire").Range("B1") = tabnom(i, 1)
FICHE_DE_SALAIRE_export_pdf
End If
Next i
Dim fichier As String
'NOM DE LA FEUILLE :
With Worksheets("Fiche de salaire")
'NOM DU FICHIER PDF A ENREGISTRER
fichier = "\" & .Range("J17")
'NOM DU FICHIERS OÙ ENREGISTRER
Dossier = .Range("K19")
'CHEMIN OÙ ENREGISTRER LE FICHIER
rep = .Range("K20")
Chemin = rep & Dossier & fichier
'EXPORT PDF
.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Chemin, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
End With
End Sub
bonjour,
voici le code adapté
Sub aargh()
Set dictnom = CreateObject("scripting.dictionary")
tabnom = Sheets("données").ListObjects("table1").ListColumns("employé").DataBodyRange
For i = LBound(tabnom) To UBound(tabnom)
If Not dictnom.exists(tabnom(i, 1)) Then
dictnom.Add tabnom(i, 1), 1
Worksheets("Fiche de salaire").Range("B1") = tabnom(i, 1)
FICHE_DE_SALAIRE_export_pdf
End If
Next i
End Sub
Sub FICHE_DE_SALAIRE_export_pdf()
Dim fichier As String
'NOM DE LA FEUILLE :
With Worksheets("Fiche de salaire")
'NOM DU FICHIER PDF A ENREGISTRER
fichier = "\" & .Range("J17")
'NOM DU FICHIERS OÙ ENREGISTRER
Dossier = .Range("K19")
'CHEMIN OÙ ENREGISTRER LE FICHIER
rep = .Range("K20")
Chemin = rep & Dossier & fichier
'EXPORT PDF
.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Chemin, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
End With
End Sub
Top merci beaucoup ! ça marche parfaitement bien
Bonjour,
content que cela fonctionne comme tu le souhaites. Pense à cloturer le sujet.