Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

XL 2016 besoin de votre aide pour adapté une macro

TAOK

XLDnaute Nouveau
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
 

Pièces jointes

  • AVRIL 2022 PLANNING extracv1.xlsm
    132.8 KB · Affichages: 7
Dernière édition:

AtTheOne

XLDnaute Accro
Supporter XLD
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

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

Taok
 

AtTheOne

XLDnaute Accro
Supporter XLD
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" :
Enrichi (BBcode):
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
 

Pièces jointes

  • Planning et gestion congés.xlsm
    31.7 KB · Affichages: 4

TAOK

XLDnaute Nouveau
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é
 

Pièces jointes

  • b.pdf
    366.3 KB · Affichages: 0
  • c.pdf
    367.5 KB · Affichages: 0
  • d.pdf
    369.8 KB · Affichages: 0
  • e.pdf
    366.5 KB · Affichages: 0

AtTheOne

XLDnaute Accro
Supporter XLD
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
 

Pièces jointes

  • AVRIL 2022 PLANNING extracv1.xlsm
    126.6 KB · Affichages: 1
Dernière édition:

Discussions similaires

Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…