XL 2016 besoin de votre aide pour adapté une macro

[TAOK]

Bonsoir
dans le fichier joint , il y a deux macro réalisées par deux membres de la communauté que j'utilise dans une autre partie du fichier
je ne sais pas comment adapter la macro pdf complet pour que celle-ci copie en pdf une feuille a chaque changement de personnes (noms) feuille reprenant type /fct/date/debut/fin
Sub impressionmois()
Dim mois$, dossier$, nf$, dat As Long
mois = [A2] & " " & [A1]
If Not IsDate(mois) Or IsNumeric([A2]) Then Exit Sub
dossier = ThisWorkbook.Path & "\" & mois & "\" 'chemin à adapter au besoin
If Dir(dossier, vbDirectory) = "" Then MkDir dossier 'crée le dossier
Application.ScreenUpdating = False
With [A9].CurrentRegion
.Parent.PageSetup.PrintArea = .Address 'zone d'impression
nf = .Cells(2, 1).NumberFormat 'mémorise le format date
For dat = Application.EoMonth(CDate(mois), 0) To .Cells(2, 1) Step -1
.Columns(1).NumberFormat = "0"
.AutoFilter 1, dat 'filtre automatique
.Columns(1).NumberFormat = nf 'restitue le format date
.Parent.ExportAsFixedFormat xlTypePDF, dossier & Format(dat, "dd mmm yyyy") & ".pdf"
Next
End With
MsgBox "Les " & Day(Application.EoMonth(CDate(mois), 0)) & " fichiers pdf de " & mois & " ont été générés"
End Sub

Merci beaucoup si vous pouviez m'aider
TAOK

 

[AtTheOne]

Bonsoir à toutes & à tous, bonsoir @TAOK

For dat = Application.EoMonth(CDate(mois), 0) To .Cells(2, 1) Step -1

[A9].CurrentRegion.Cells(2,1) renvoie le premier nom (dans ton exemple la cellule A10 qui vaut "z".
Si c'est la première date à laquelle tu veux faire référence il faut mettre .cells(2,4) ce qui dans ton exemple renvoie la cellule D10 qui vaut 01/04/2022.
Je n'ai pas vérifié le reste ...
Amicalement
Alain

 

[TAOK]

Bonsoir à toutes & à tous, bonsoir @TAOK

[A9].CurrentRegion.Cells(2,1) renvoie le premier nom (dans ton exemple la cellule A10 qui vaut "z".
Si c'est la première date à laquelle tu veux faire référence il faut mettre .cells(2,4) ce qui dans ton exemple renvoie la cellule D10 qui vaut 01/04/2022.
Je n'ai pas vérifié le reste ...
Amicalement
Alain

Merci Bien
je vais tester et faire les adaptations au fur et a mesure

Taok

 

[AtTheOne]

Re Bonsoir,
Je ne sais pas ce que j'ai fait de mon précédent Post, du coup j'en écris un nouveau...
En fait j'ai réécrit une macro "ImpressionNom()" dans le module "Mdl_Nominatif" :

Sub ImpressionNom()
    Dim mois$, dossier$, Dc As Object, Nom, Noms, Zimp As String
    
    mois = [A2] & " " & [A1]
    If Not IsDate(mois) Or IsNumeric([A2]) Then Exit Sub
    
    dossier = ThisWorkbook.Path & "\" & mois & "\" 'chemin à adapter au besoin
    If Dir(dossier, vbDirectory) = "" Then MkDir dossier 'crée le dossier
    
    Application.ScreenUpdating = False
    
    With [A9].CurrentRegion
    
        'Liste des noms sans doublons
        Set Dc = CreateObject("Scripting.dictionary")
        Noms = .Offset(1).Columns(1).Resize(.Rows.Count - 1)
        For Each Nom In Noms
            Dc(Nom) = Nom
        Next Nom
        If Dc.exists("") Then Dc.Remove ("")

        'Redéfinir la zone d'impression
        Zimp = .Parent.PageSetup.PrintArea
        .Parent.PageSetup.PrintArea = .Offset(0, 1).Resize(, .Columns.Count - 1).Address 'zone d'impression

        'Boucle sur les noms
        For Each Nom In Dc.keys
            .AutoFilter 1, Nom
           .Parent.ExportAsFixedFormat xlTypePDF, dossier & Nom & ".pdf"
        Next Nom

        'Effacer les filtres
        .Parent.AutoFilter.ShowAllData
        'Rétablir la zone d'impression
        .Parent.PageSetup.PrintArea = Zimp
        
    End With
    Application.ScreenUpdating = True
    MsgBox "Les " & Dc.Count & " fichiers pdf nominatifs de " & mois & " ont été générés"
    
End Sub

Amicalement
Alain

 

[AtTheOne]

Bonsoir @TAOK
Pas de réaction à mon post#4 ?
Alain

 

[TAOK]

Bonsoir @TAOK
Pas de réaction à mon post#4 ?
Alain

Bonsoir AtTheOne
Désolé de n'avoir pu te répondre avant , je viens de copier ta macro dans le fichier avril et tester
C'est Nickel et rapide
SUPER MERCI
voici ce que cela donne mais pas tout mis


mais pas compris le fichier que tu as envoyé

 

[AtTheOne]

Bonsoir @TAOK
En tout premier : merci pour le retour.

mais pas compris le fichier que tu as envoyé

Ma souris a dû glisser lorsque je sélectionnais la pièce jointe, je ne peux plus modifier ce post donc je reprends ici ma solution ;
La macro : voir post#4

La pièce jointe (la bonne cette fois) voir PJ
Amicalement
Alain