Microsoft 365 VBA-Fiche de synthèse à partir d'une liste

[SOSOCONNAITPASLEVBA]

Bonjour,

J’ai besoin à partir de l’onglet ‘Liste’ de remplir l’onglet ‘Lettre’ et de créer une feuille PDF comme joint. (nommée ‘Code3D – Suivi formations’). Mais la nommer et la créer je sais faire, je ne saurai peut-être pas à quel moment de la macro l’intégrer en revanche.
Il faut une fiche PDF par Code 3D identique (Code 3D à coller en C5 de l’onglet ‘Lettre’).
Les codes 5D (sous code des codes 3D) doivent être renseignés en ligne 10 de l’onglet ‘Lettre’.
Les résultats des Stages dans la colonne des codes 5D concernés de l’onglet ‘Lettre’.
Il y a au maximum 13 codes 5D pour un code 3D.

Quelqu'un pourrait-il m'aider ?
Sophie

 

[Hasco]

Bonjour,

Avec 365, une proposition par formule pour remplir le formulaire.

Sur feuille Liste :
Transformation du tableau en tableau structuré, nommé T_Liste
En R2 création d'une liste nommée (Codes3d) des Codes 3D uniques au moyen de la formule : =UNIQUE(T_Liste[Code 3D])

Sur feuille 'Lettre'
En C5 une liste de validation, avec les Codes 3d uniques
En AE6 un tableau transposé des données filtrées sur le code 3d donné en C5
Formule en AE6 :
=SIERREUR(TRANSPOSE(FILTRE(T_Liste;T_Liste[Code 3D]=C5));"Oups")
De E9 à AC 28 la formule (résultat masqué par couleur écriture identique à la couleur de fond) :
= (ENT(COLONNE()-5)/2+1)*ET(MOD(COLONNE();2)=1;ENT(COLONNE()-5)/2+1 <= COLONNES($AE$6#))
qui donne un numéro permettant les recherches dans le tableau AE6#
De D12 à D24 la formule (résultat masqué également) :
=(ENT((LIGNE()-11)/2)+1)*(MOD(LIGNE()-11;2))*((ENT((LIGNE()-11)/2)+1)<=LIGNES($AE$6#))
pour les bon numéros de lignes (idem de D28 à D38)

De E12 à AC24 formule
=SI(($D12*E$9)>0;INDEX($AE$6#;$D12+2;E$9);"")
pour retrouver les données filtrées (idem E28:AC38)

Cordialement

Pour rappel dans AE6# le # est là pour dire "tout le tableau qui commence en AE6" et dont les nombres de lignes et colonnes sont dynamiques

 

[SOSOCONNAITPASLEVBA]

Merci Hasco,

C'est déjà mieux que de tout me coller à la main comme je l'ai fait 1 fois.
Mais ce que je veux c'est une macro qui fasse tout toute seule et m'enregistre les PDF au nom indiqué ci-dessus. Là je vais avoir 500 Codes 3D uniques je ne peux pas soit saisir les codes 1 par 1 ou même le faire avec une liste déroulante, et faire imprimer en PDF et renommer correctement à chaque feuille, sinon je ne vais pas m'en sortir.
Il faudrait pouvoir entrer ce que tu as fait en vba en demandant de faire ces étapes de changer de code 3D et imprimer pdf, puis recommencer à chaque nouveau code 3D. Tu vois ce que je veux dire ?

 

[Hasco]

Re,

Non pas que je ne sache pas écrire de VBA, mais je ne fais plus de vba ex-nihilo.
Où sont vos tentatives de macro pour réaliser ce que vous voulez ?
Les demandes de vba par des forumeurs qui attendent du tout cuit ne sont pas pour moi.
Le forum n'est pas une société de services à qui il suffit de donner un cahier des charges pour obtenir ce qu'on veut.

Pas de bras, pas de vba

Bonnes recherches

 

[SOSOCONNAITPASLEVBA]

J'ai fait quelque chose mais c'est nul alors je n'ai même pas osé le mettre. Ce n'est pas du tout adapté car je ne sais pas lui dire de ne faire qu'une fiche par code 3D et d'en refaire une lorsque le code 3D change. ni de à chaque nouvelle ligne de code 5D, décaler de 2 colonnes le collage des valeurs dans 'Lettre' pour utiliser les box suivantes.

 

[Hasco]

Re,

Pour du null c'est plutôt pas mal du tout .
Allez y doucement si vous ne voulez pas vous lasser.

Mais comme c'est une autre méthode que celle que j'ai commencé, voici une macro que vous pouvez ajouter dans le fichier joint au post #2.

Sub Truc()
    Const MaxSecondes As Single = 15
    Dim listeCodes As Variant, item As Variant
    Dim tps As Single
   
    With ThisWorkbook
        listeCodes = .Names("Codes3D").RefersToRange.Value
        For Each item In listeCodes
            With .Sheets("Lettre")
                .Select ' Vraiment facultatif
                .Range("C5") = item
                '
                ' Prévoir pendant la phase de tests et
                ' suivant le fichier et la machine un temps d'attente du recalcul
                ' ici limité à 15 secondes maximum mais sans minimum
                ' cela peut être quasi instantané
                tps = Timer
                Do
                    DoEvents
                Loop While Application.CalculationState <> xlDone And Timer < tps + MaxSecondes
                '
                ' une fois l'application calculée, lancer ci-dessous
                ' les actions d'enregistrement pdf
                .ExportAsFixedFormat _
                            Type:=xlTypePDF, _
                            Filename:=ThisWorkbook.Path & "\Fichier_" & item & ".pdf", _
                            Quality:=xlQualityStandard, _
                            includeDocProperties:=True, _
                            IgnorePrintAreas:=False, _
                            OpenAfterPublish:=False
               
            End With
        Next
    End With

End Sub

Ce qui prendra du temps dans cette macro c'est surtout l'exportation en pdf.

Cordialement

 

[SOSOCONNAITPASLEVBA]

Merci beaucoup, j'étais en train (depuis 1h30) d'essayer de partir sur votre base de formule en automatisant la sélection des codes 3D 1 à un, ce que vous avez fait en fait. J'avais abouti à un quelque chose mais avec une boucle qui ne se terminait pas apparemment.
Prochaine étape je vais essayer d'intégrer votre code avec le miens pour que tout aille bien dans le nom des fichiers....Mais demain je pense, suis hs de concentration maintenant. En tous cas le votre fonctionne évidemment, j'ai testé

Bonne soirée.

 

[Hasco]

mais avec une boucle qui ne se terminait pas apparemment.

C'est pour ça, que dans la phase de test, je rajoute toujours une condition de temps pour sortir d'une boucle

Cordialement

 

[job75]

Bonsoir,

Pour créer les fichiers PDF il faut du VBA alors faisons tout en VBA :

Sub PDF()
Dim ncol%, tablo, ub&, Code As Range, Stage As Range, R As Range, rc&, cc%, i&, resu(), j&, col%, k%, lig&
With Sheets("liste").[A1].CurrentRegion
    .Sort .Cells(1), xlAscending, Header:=xlYes
    ncol = .Columns.Count
    If ncol < 2 Then ncol = 2
    tablo = .Resize(.Rows.Count + 1, ncol) 'matrice, plus rapide, 1 ligne de plus
    ub = UBound(tablo) - 1
End With
With Sheets("Lettre")
    If .FilterMode Then .ShowAllData 'si la feuille est filtrée
    Set Code = .[B6] 'à adapter
    Set Stage = .[B10:B38] 'à adapter
    Set R = .[E10:AC38] 'à adapter
    rc = R.Rows.Count: cc = R.Columns.Count
    Application.ScreenUpdating = False
    For i = 2 To ub
        Code = tablo(i, 1) 'Code 3D
        ReDim resu(1 To rc, 1 To cc) 'RAZ
        col = -1
        For j = i To ub
            col = col + 2
            resu(1, col) = tablo(j, 2) 'Codes 5D
            For k = 3 To ncol
                lig = Application.Match(tablo(1, k), Stage, 0)
                resu(lig, col) = tablo(j, k)
            Next k
            If tablo(j + 1, 1) <> tablo(j, 1) Then
                R = resu 'restitution
                .ExportAsFixedFormat xlTypePDF, ThisWorkbook.Path & "\" & tablo(i, 1) & " - Suivi formations.pdf"
                i = j
                Exit For
            End If
    Next j, i
End With
End Sub

Vous devrez certainement revoir les couleurs, la police rouge sur fond gris n'est guère lisible...

A+

 

[SOSOCONNAITPASLEVBA]

Merci Job75 2 techniques sont toujours bonnes à prendre. Je vais me pencher dessus pour essayer de comprendre le code.

 

[job75]

Bonjour le forum,

Un complément dans ce fichier (2) avec une liste de validation en B6 de la feuille "Lettre".

Le code de cette feuille :

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [B6]) Is Nothing Then Exit Sub
MacroChange = True 'variable déclarée Public dans Module1
PDF 'lance la macro
MacroChange = False
End Sub

La macro PDF a été légèrement modifiée, elle se déclenche quand on modifie le code en B6.

Un fichier PDF est créé pour chaque code choisi mais bien sûr on peut les créer tous en même temps en cliquant sur le bouton de la 1ère feuille.

A+