Compter un nombre de lignes, concaténer une phrase, et boucle

Bonjour à tous !

Très très grand débutant en VBA, je dois écrire pour le travail plusieurs macros en VBA, et je ne m’en sors pas du tout avec juste le générateur de macro …

J’ai un classeur qui contient plusieurs onglets, comme par exemple « ACTIVITÉS D'ÉVALUATION », « ACTIVITÉS ÉDITORIALES », « ACTIVITÉS PÉDAGOGIQUES », etc.

Chaque onglet contient un tableau avec des en-têtes comme « Nom », « Prénom », Numéro d’équipe », « Nature de l’activité », « Nom du projet », etc.

Une collègue ira sur un onglet (par exemple « ACTIVITÉS D'ÉVALUATION »), filtrera le tableau par numéro d’équipe, (par exemple « Equipe 01 ») ou par nom d’auteur (« Golf ») pour appeler les données du-dit tableau, puis cliquera sur un bouton « Export » appelant une macro VBA.

Cette macro devra :

- Me compter le nombre de lignes dans le tableau filtré, pour que la macro m’indique combien d’activités ont été rédigées par l’équipe.

(Par exemple : L'équipe n°XX a rédigé XX activité(s) d'évaluation.)

- Ecrire une phrase en prenant les informations du tableau qui se trouve dans l’onglet « ACTIVITÉS D'ÉVALUATION »

(Pour donner un résultat type : Emmanuel Golf de l'Équipe 01 a participé(e) à un(e) Reviewing pour Blood, le 09/04/2019, pour le laboratoire LaboSympaN1, concernant l'article ArticleBofBof1 de la revue Blood.)

Copier cette phrase dans la cellule A5 de la feuille « impression ».

Retourner sur « ACTIVITÉS D'ÉVALUATION ».

Écrire la même phrase que précédemment, mais à la ligne, et avec les données de la ligne 5, 6, 7, etc. et les copier sur les cellules en dessous jusqu’à ce qu’il n’y ait plus de lignes dans le tableau filtré.

La feuille « impression » est en format A4, et comprendra plusieurs boutons qui appelleront des scripts pour exporter cette feuille en PDF ou en word. Il faut que tout soit mise en forme automatiquement donc.

Le fichier Excel : https://www.cjoint.com/c/IECpaPGeNwd

Un grand merci !!

J’ai donc commencé le script suivant, mais malheureusement ça bloque :

Private Sub ACTDEVALpdf_Click()
'compter le nombre de lignes filtrées du tableau
nbdelignes = Sheets("ACTIVITÉS D'ÉVALUATION").Range("C65536").End(xlUp).Row
'indiquer ce nombre dans une cellule
'Le probleme est que cette formule me donne le nombre total de lignes, et pas le nombre de lignes filtrées.
Worksheets("impression").Activate
Worksheets("impression").Range("B3").Select
Selection.Value = nbdelignes

'prendre les éléments du tableau, et les concaténer dans une phrase
Worksheets("ACTIVITÉS D'ÉVALUATION").Activate
Dim Nom As String
Dim Prenom As String
Dim Equipe As String
Dim NatureActivite As String
Dim NomProjet As String
Dim DateEval As Date
Dim NomLabo As String
Dim NomArticle As String
Dim NomRevue As String
Dim Responsabilite As String
Dim NomInstance As String
Dim Precisions As String
Dim Phrase As String

Nom = Range("A$4").Value
Prenom = Range("B$4").Value
Equipe = Range("C$4").Value
NatureActivite = Range("D$4").Value
NomProjet = Range("E$4").Value
DateEval = Range("F$4").Value
NomLabo = Range("G$4").Value
NomArticle = Range("H$4").Value
NomRevue = Range("I$4").Value
Responsabilite = Range("J$4").Value
NomInstance = Range("K$4").Value
Precisions = Range("L$4").Value

    If J$4 = "Oui" Then
    'ajouter un bout de phrase si "Oui" est présent dans la colonne J (J4, J5, ...) :
    Phrase = "- " &Nom& " " &Prenom& " de l'"&Equipe& " a participé(e) à un(e) "&NatureActivite&" pour "&NomProjet&", le "&DateEval&", pour le laboratoire "&NomLabo&", concernant l'article "&NomArticle&" de la revue "&NomRevue&". Cette personne a eu une responsabilité d'évaluation pour "&NomInstance&", "&Precisions&"."
    Else
    'Si "non" est renseigné en J4, J5,..., mettre un point.
    Phrase = "- " &Nom& " " &Prenom& " de l'"&Equipe& " a participé(e) à un(e) "&NatureActivite&" pour "&NomProjet&", le "&DateEval&", pour le laboratoire "&NomLabo&", concernant l'article "&NomArticle&" de la revue "&NomRevue&"."
    End If

'Coller cette phrase dans une cellule
Worksheets("impression").Activate
Worksheets("impression").Range("A4").Select
Selection.Value = Phrase

'Mettre la cellule en forme :
    'Renvoyer à la ligne automatiquement
    Columns("A:A").WrapText = True
    'Fusionner et centrer les cellules
    Range("A:A").Select
    With Selection
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlBottom
    .WrapText = False
    .Orientation = 0
    .AddIndent = False
    .IndentLevel = 0
    .ShrinkToFit = False
    .ReadingOrder = xlContext
    .MergeCells = False
    End With
    Selection.Merge

'Passer à la ligne suivante
'Je bloque, mettre une boucle For ? Mais je ne vois pas comment la mettre en forme ?

'Lorsque la ligne est vide, tout arrêter et se positionner sur la feuille "impression"
Sheets("impression").Select

End Sub

bonjour,

une proposition sans doute à encore adapter.

Private Sub ACTDEVALpdf_Click()
    With Worksheets("ACTIVITÉS D'ÉVALUATION")
        'compter le nombre de lignes  du tableau
        nbdelignes = .Range("C" & Rows.Count).End(xlUp).Row

        'prendre les éléments du tableau, et les concaténer dans une phrase

        Dim Nom As String
        Dim Prenom As String
        Dim Equipe As String
        Dim NatureActivite As String
        Dim NomProjet As String
        Dim DateEval As Date
        Dim NomLabo As String
        Dim NomArticle As String
        Dim NomRevue As String
        Dim Responsabilite As String
        Dim NomInstance As String
        Dim Precisions As String
        Dim Phrase As String

        For i = 4 To nbdelignes
            If Not .Rows(i).Hidden Then 'si ligne visible, = résultat du filtre
            'compter le nombre de lignes filtrées du tableau dans ns
                ns = ns + 1
                Nom = .Range("A$" & i).Value
                Prenom = .Range("B$" & i).Value
                Equipe = .Range("C$" & i).Value
                NatureActivite = .Range("D$" & i).Value
                NomProjet = .Range("E$" & i).Value
                DateEval = .Range("F$" & i).Value
                NomLabo = .Range("G$" & i).Value
                NomArticle = .Range("H$" & i).Value
                NomRevue = .Range("I$" & i).Value
                Responsabilite = .Range("J$" & i).Value
                NomInstance = .Range("K$" & i).Value
                Precisions = .Range("L$" & i).Value

                If .Range("J$" & i) = "Oui" Then
                    'ajouter un bout de phrase si "Oui" est présent dans la colonne J (J4, J5, ...) :
                    Phrase = "- " & Nom & " " & Prenom & " de l'" & Equipe & " a participé(e) à un(e) " & NatureActivite & " pour " & NomProjet & ", le " & DateEval & ", pour le laboratoire " & NomLabo & ", concernant l'article " & NomArticle & " de la revue " & NomRevue & ". Cette personne a eu une responsabilité d'évaluation pour " & NomInstance & ", " & Precisions & "."
                Else
                    'Si "non" est renseigné en J4, J5,..., mettre un point.
                    Phrase = "- " & Nom & " " & Prenom & " de l'" & Equipe & " a participé(e) à un(e) " & NatureActivite & " pour " & NomProjet & ", le " & DateEval & ", pour le laboratoire " & NomLabo & ", concernant l'article " & NomArticle & " de la revue " & NomRevue & "."
                End If

                'Coller cette phrase dans une cellule

                texte = texte & IIf(texte <> "", vbNewLine, "") & Phrase
            End If
        Next i
    End With

    'Lorsque la ligne est vide, tout arrêter et
    'Mettre la cellule en forme :

    With Worksheets("impression")
        'indiquer le nombre de lignes sélectionnées dans une cellule
        .Range("A3:A5").ClearContents
        .Range("A3").Value = "Pour l'équipe " & Equipe & " :" ' !! ne fonctionne correctement que si un filtre sur une seule équipe a été appliqué
        .Range("A4").Value = "il a été rédigé " & ns & " activité" & IIf(ns > 1, "s", "") & " d'évaluation :"
        With .Range("A5")
            'Renvoyer à la ligne automatiquement
            .Value = texte
            .WrapText = True
            .Columns.AutoFit
        End With

        ' se positionner sur la feuille "impression"
        .Select
    End With
End Sub

Un énorme merci à toi !!!!!

ça fonctionne parfaitement, je n'ai plus qu'à adapter le code pour mes 8 feuilles restantes, faire des boutons d'enregistrements en PDF et word, et ça devrait être bon !!

Je vais peut être aussi essayer de faire une liste déroulante pour que du VBA me prenne les résultats d'une équipe donnée dans toutes les feuilles.

Bonjour bonjour !

On vient de m'indiquer que certaines données seront en gras ou italique, et qu'il faut absolument garder cette mise en forme source pour mon export ....

Le souci est qu'avec ce VBA, la mise en forme ne se copie pas.

J'ai vu un .Range("D1:D5").PasteSpecial _ Operation:=xlPasteSpecialOperationAdd sur la doc microsoft qui pourrait m'aller, mais n'arrive pas à le mettre en place sur mes Range, auriez vous des idées svp ?

Private Sub BREVET_export_Click()

    With Worksheets("BREVETS")
        'compter le nombre de lignes  du tableau
        nbdelignes = .Range("C" & Rows.Count).End(xlUp).Row

        'prendre les éléments du tableau, et les concaténer dans une phrase

        Dim DateBrevet As Date
        Dim Reference As String
        Dim TitreBrevet As String
        Dim Nom As String
        Dim Prenom As String
        Dim NumEquipe As String
        Dim Niveau As String

        For i = 4 To nbdelignes
            If Not .Rows(i).Hidden Then 'si ligne visible, = résultat du filtre
            'compter le nombre de lignes filtrées du tableau dans la variable ns
                ns = ns + 1
            ' on définit les variables, avec colonne$ on récupère la valeur en descendant de ligne en ligne tout en restant sur la colonne
                DateBrevet = .Range("A$" & i).Value .PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone,
                Reference = .Range("B$" & i).Value .PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone,
                TitreBrevet = .Range("C$" & i).Value .PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone,
                Nom = .Range("D$" & i).Value .PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone,
                Prenom = .Range("E$" & i).Value .PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone,
                NumEquipe = .Range("F$" & i).Value .PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone,
                Niveau = .Range("G$" & i).Value .PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone,

                Phrase = "- " & Nom & " " & Prenom & " de l'" & NumEquipe & " a déposé(e) le brevet " & TitreBrevet & ", ayant pour référence " & Reference & ", le " & DateBrevet & ". À ce jour, le brevet est " & Niveau & "."

                'Coller cette phrase dans une cellule
                texte = texte & IIf(texte <> "", vbNewLine, "") & Phrase
            End If
        Next i
    End With

    'Lorsque la ligne est vide, tout arrêter et
    'Mettre la cellule en forme :

    With Worksheets("impression")
        'indiquer le nombre de lignes sélectionnées dans une cellule
        .Range("A3:A100").ClearContents
        .Range("A3").Value = "Pour l'" & NumEquipe & " :" ' !! ne fonctionne correctement que si un filtre sur une seule équipe a été appliqué
        .Range("A4").Value = "il a été déposé " & ns & " brevet" & IIf(ns > 1, "s", "") & " :"
        With .Range("A5")
            'Renvoyer à la ligne automatiquement
            .Value = texte
            .WrapText = True
            .Columns.AutoFit
        End With

        ' se positionner sur la feuille "impression"
        .Select
    End With

End Sub

Un petit up

Qqn saurait comment faire fonctionner le

.Range("D1:D5").PasteSpecial _ Operation:=xlPasteSpecialOperationAdd

dans mon cas svp ?

Ou je fais un nouveau sujet ?

Merci !!