IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Macros et VBA Excel Discussion :

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


Sujet :

Macros et VBA Excel

Vue hybride

Message précédent Message précédent   Message suivant Message suivant
  1. #1
    Membre averti
    Profil pro
    Inscrit en
    Juin 2013
    Messages
    25
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Juin 2013
    Messages : 25
    Par défaut Compter un nombre de lignes, concaténer une phrase avec variables, 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.

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

    Le fichier Excel en PJ,Tableau-pour-export.xlsm

    Un grand merci

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
     
    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

  2. #2
    Expert confirmé
    Homme Profil pro
    Electrotechnicien
    Inscrit en
    Juillet 2016
    Messages
    3 241
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 71
    Localisation : France, Var (Provence Alpes Côte d'Azur)

    Informations professionnelles :
    Activité : Electrotechnicien

    Informations forums :
    Inscription : Juillet 2016
    Messages : 3 241
    Par défaut
    Bonjour,

    Avant toute chose, commencez par corriger les erreurs de saisies, le "&" ,"ET commercial", ne doit pas être accolé aux autres caractères.
    Remplacez
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
        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
    par
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
       If [J4] = "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
    Cdlt

  3. #3
    Membre averti
    Profil pro
    Inscrit en
    Juin 2013
    Messages
    25
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Juin 2013
    Messages : 25
    Par défaut
    Bonjour,

    Merci de votre réponse !
    Une première étape de faite :

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
     
    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 [J4] = "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

  4. #4
    Inactif  

    Homme Profil pro
    cuisiniste
    Inscrit en
    Avril 2009
    Messages
    15 374
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Var (Provence Alpes Côte d'Azur)

    Informations professionnelles :
    Activité : cuisiniste
    Secteur : Bâtiment

    Informations forums :
    Inscription : Avril 2009
    Messages : 15 374
    Billets dans le blog
    8
    Par défaut re
    re
    bonjour somme toute ce n'est que de la concaténation pas bien compliqué
    cependant tes données sont pas bien pareilles dans le sens ou par exemple tu a "Equipe 01 " et "Equipe 01" et j'en passe et tant d'autre
    alors que justement on en a besoins pour le "Il a été rédigé 4 activité(s) d'évaluation :"
    d'autant plus que l'on peut meme pas modifier tes cellules elle sont bloquée
    mes fichiers dans les contributions:
    mail avec CDO en vba et mail avec CDO en vbs dans un HTA
    survol des bouton dans userform
    prendre un cliché d'un range

    si ton problème est résolu n'oublie pas de pointer : : ça peut servir aux autres
    et n'oublie pas de voter

  5. #5
    Inactif  

    Homme Profil pro
    cuisiniste
    Inscrit en
    Avril 2009
    Messages
    15 374
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Var (Provence Alpes Côte d'Azur)

    Informations professionnelles :
    Activité : cuisiniste
    Secteur : Bâtiment

    Informations forums :
    Inscription : Avril 2009
    Messages : 15 374
    Billets dans le blog
    8
    Par défaut re
    re
    il faut trimer toute tes variables

    regarde dans la fentre d'execution
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    Sub test()
    '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
        Dim dicoequipe
        Set dicoequipe = CreateObject("scripting.dictionary")
        For i = 4 To Cells(Rows.Count, 1).End(xlUp).Row
     
            Phrase = ""    ' si on veux vider a chaque tour
            Nom = Range("A" & i).Value
            Prenom = Range("B" & i).Value
            Equipe = Trim(Range("C" & i).Value)
            NatureActivite = Trim(Range("D" & i).Value)
            NomProjet = Trim(Range("E" & i).Value)
            DateEval = Range("F$4").Value
            NomLabo = Trim(Range("G" & i).Value)
            NomArticle = Trim(Range("H" & i).Value)
            NomRevue = Trim(Range("I" & i).Value)
            Responsabilite = Trim(Range("J" & i).Value)
            NomInstance = Trim(Range("K" & i).Value)
            Precisions = Trim(Range("L" & i).Value)
            Phrase = 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
            'ajouter un bout de phrase si "Oui" est présent dans la colonne J (J4, J5, ...) :
            If Responsabilite = "Oui" Then Phrase = Phrase & vbCrLf & ". Cette personne a eu une responsabilité d'évaluation pour " & NomInstance & ", " & Precisions & "." Else Phrase = Phrase & vbCrLf
            Phrase = Phrase & vbCrLf & vbCrLf & vbCrLf
            dicoequipe(Equipe) = dicoequipe(Equipe) & "|" & Phrase
            Debug.Print Phrase
        Next
        'exemple pour afficher  les articles de l'equipe 1 :
    End Sub
    Nom : demo2.gif
Affichages : 581
Taille : 1,28 Mo
    mes fichiers dans les contributions:
    mail avec CDO en vba et mail avec CDO en vbs dans un HTA
    survol des bouton dans userform
    prendre un cliché d'un range

    si ton problème est résolu n'oublie pas de pointer : : ça peut servir aux autres
    et n'oublie pas de voter

  6. #6
    Membre averti
    Profil pro
    Inscrit en
    Juin 2013
    Messages
    25
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Juin 2013
    Messages : 25
    Par défaut
    Un grand merci pour ton bout de code !

    Je ne connaissais pas la fenêtre d’exécution, c'est plus facile pour travailler son code

    Après avoir affecté cette macro à un bouton, il n'écrit que la dernière phrase concaténée ("Tennis Armelle ..."), au lieu d'écrire les phrases les unes en dessous des autres, ce qui me parait logique puisque j'avais indiqué
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
     
    Worksheets("impression").Activate
    Worksheets("impression").Range("A4").Select
    Selection.Value = Phrase
    Donc il me colle la "dernière phrase" en A4. Mais comment faire pour qu'il me colle chaque phrase en A4, A5, A6, A7 etc ...?

  7. #7
    Inactif  

    Homme Profil pro
    cuisiniste
    Inscrit en
    Avril 2009
    Messages
    15 374
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Var (Provence Alpes Côte d'Azur)

    Informations professionnelles :
    Activité : cuisiniste
    Secteur : Bâtiment

    Informations forums :
    Inscription : Avril 2009
    Messages : 15 374
    Billets dans le blog
    8
    Par défaut re
    re
    ben oui cette fenêtre c'est comme le "console" pour beaucoup de langage

    du coup je suis aller un peu plus loin
    j'ai fait une fonction qui te renvoie un tableau de tableau (je sais c'est rigolo)

    dans mes_equipes tu a tout

    il te sera facile dans la boucle a la place des debug.print les placer dans tes cellules selon leur indexs
    les commentaires et exemples parlent d'eux mêmes c'est assez simple
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    Option Explicit
    Sub test()
        Dim mes_equipes As Variant, i&, a&
        mes_equipes = mes_articles_par_equipe
        'affichage dans la fenetre d'execution des articles par equipe
        For i = 1 To UBound(mes_equipes)
            Debug.Print "         pour l'equipe N°" & i & vbCrLf & "il a été rédigé " & UBound(mes_equipes(i)) - 1 & " activités d'évaluation"
            For a = 1 To UBound(mes_equipes(i))
                Debug.Print mes_equipes(i)(a)
                Debug.Print vbCrLf
            Next
        Next
        'pour l 'equipe 01 article(1) c'est mes_equipes(1)(1)
        'pour l 'equipe 01 article(2) c'est mes_equipes(1)(2)
        'etc...etc...
        'exemple l'équipe 3 article 3
        MsgBox mes_equipes(3)(3)
    End Sub
    '
    Function mes_articles_par_equipe()
    '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
        Dim dicoequipe
        Dim les_equipes() As Variant
        Dim ind As Long
        Dim i As Long
        For i = 4 To 11    'Cells(Rows.Count, 1).End(xlUp).Row
            ' J'AI TRIME TOUTE TES VARIABLES (TROP D'IRREGULARITES DANS LES CELLULES)!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
            Nom = Range("A" & i).Value
            Prenom = Range("B" & i).Value
            Equipe = Trim(Range("C" & i).Value)
            NatureActivite = Trim(Range("D" & i).Value)
            NomProjet = Trim(Range("E" & i).Value)
            DateEval = Range("F$4").Value
            NomLabo = Trim(Range("G" & i).Value)
            NomArticle = Trim(Range("H" & i).Value)
            NomRevue = Trim(Range("I" & i).Value)
            Responsabilite = Trim(Range("J" & i).Value)
            NomInstance = Trim(Range("K" & i).Value)
            Precisions = Trim(Range("L" & i).Value)
            ind = Val(Replace(Equipe, "Équipe", ""))
            ReDim Preserve les_equipes(1 To ind)
            Phrase = ""
            Phrase = 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
            'ajouter un bout de phrase si "Oui" est présent dans la colonne J (J4, J5, ...) :
            If Responsabilite = "Oui" Then Phrase = Phrase & vbCrLf & ". Cette personne a eu une responsabilité d'évaluation pour " & NomInstance & ", " & Precisions & "." & "|" Else Phrase = Phrase & "|"
            les_equipes(ind) = les_equipes(ind) & Phrase
        Next
        For i = LBound(les_equipes) To UBound(les_equipes)
            les_equipes(i) = Split("|" & les_equipes(i), "|")' on transforme les phrases qui sont dans le tableau les_equipes en sous tableau de phrases
        Next
        ' tu a maintenant une variable tableau ("les_equipes")indée au numero d'equipe( equipe 01 = les_equipes(1) etc.....)
        'qui contiennent un tableau (anonyme)des  articles concernants leur membres
     
        mes_articles_par_equipe = les_equipes
    End Function
    mes fichiers dans les contributions:
    mail avec CDO en vba et mail avec CDO en vbs dans un HTA
    survol des bouton dans userform
    prendre un cliché d'un range

    si ton problème est résolu n'oublie pas de pointer : : ça peut servir aux autres
    et n'oublie pas de voter

  8. #8
    Rédacteur/Modérateur


    Homme Profil pro
    Formateur et développeur chez EXCELLEZ.net
    Inscrit en
    Novembre 2003
    Messages
    19 125
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 58
    Localisation : Belgique

    Informations professionnelles :
    Activité : Formateur et développeur chez EXCELLEZ.net
    Secteur : Enseignement

    Informations forums :
    Inscription : Novembre 2003
    Messages : 19 125
    Billets dans le blog
    131
    Par défaut
    Salut.

    Pour ce genre de projets (comme pour tous les projets), je te conseille de bien découper ton travail en petits morceaux plus digestes.

    Je te conseille également de te méfier de solutions qui sortent du cadre du VBA. Ici, le html évoqué pour recopier l'habillage du texte est à mon avis contre-productif. VBA et HTML ne sont pas vraiment copains. Si le VBA stockait les infos de mise en page en html, je pourrais être d'accord, mais ce n'est pas le cas. Dès lors, travailler avec une "techno" externe à VBA t'imposera de traduire la mise en forme de ton texte en html à la copie pour la retraduire à la sauce VBA lors du collage... (Tiens, au fait, tu connais les balises html qui vont te permettre de réaliser cela et comment les assembler? ).

    Il est de loin préférable d'étudier comment c'est fait dans Excel. Vu que le texte est attaché à une cellule, on regarde si, dans les propriétés et méthodes de l'objet Range, on trouve quelque chose de chouette. Pour cela, il y a l'explorateur d'objet (F2), ou la saisie semi-automatique. Avec un peu d'intuition, on va se tourner vers la propriété Characters...

    Nom : 2019-06-04_062715.png
Affichages : 410
Taille : 3,7 Ko

    Nom : 2019-06-04_063441.png
Affichages : 484
Taille : 10,6 Ko


    Cette propriété permet de manipuler les caractères contenus dans une cellule et de lire ou définir les propriétés d'habillage (gras, italique, police, taille, ...). En fouillant un peu, tu verras vite que c'est la propriété Font de l'objet Characters qu'il faut manipuler pour arriver à tes fins.

    Nom : 2019-06-04_063606.png
Affichages : 454
Taille : 22,5 Ko


    Donc, Characters permet de travailler avec un ou plusieurs caractères contenus dans la cellule, et d'en manipuler les propriétés d'habillage. Il ne reste plus qu'à copier les textes des cellules à concaténer bout à bout en spécifiant un séparateur (espace, chr(10), plusieurs caractères) puis, caractère par caractère pour chaque cellule source de la concaténation, de lire les propriétés d'habillage et de les affecter au caractère correspondant de la chaine concaténée.

    La procédure suivante fait cela. Je pense que j'ai illustré toutes les propriétés utilisables. Note que toutes les propriétés de Font que tu vois ne sont pas applicables à notre cas (par exemple, Background). Tu ne peux en effet jouer que sur celles que tu peux manipuler en Excel pour habiller du texte à l'intérieur d'une cellule. Note également qu'apparemment, la propriété Subscript (mise en indice) n'est pas retranscrite (dans l'exemple illustré en tout cas... A voir).

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    Sub ConcatenateWithFormatText(Cells As Range, Target As Range, Separator As String)
      Dim Text As String
      Dim Cell As Range
      Dim Position As Long
      Dim f
      Dim Counter As Long
     
      For Each Cell In Cells
        Text = Text & Cell.Value & Separator
      Next
      Text = Left(Text, Len(Text) - Len(Separator))
      Target.Value = Text
     
      Position = 1
      For Each Cell In Cells
        f = getFormatText(Cell)
        For Counter = 1 To Len(Cell.Value)
          Target.Characters(Position, 1).Font.Bold = Cell.Characters(Counter, 1).Font.Bold
          Target.Characters(Position, 1).Font.Color = Cell.Characters(Counter, 1).Font.Color
          Target.Characters(Position, 1).Font.Italic = Cell.Characters(Counter, 1).Font.Italic
          Target.Characters(Position, 1).Font.Name = Cell.Characters(Counter, 1).Font.Name
          Target.Characters(Position, 1).Font.Size = Cell.Characters(Counter, 1).Font.Size
          Target.Characters(Position, 1).Font.Strikethrough = Cell.Characters(Counter, 1).Font.Strikethrough
          Target.Characters(Position, 1).Font.Subscript = Cell.Characters(Counter, 1).Font.Subscript ' Apparemment inopérant
          Target.Characters(Position, 1).Font.Superscript = Cell.Characters(Counter, 1).Font.Superscript
          Target.Characters(Position, 1).Font.Underline = Cell.Characters(Counter, 1).Font.Underline
          Position = Position + 1
        Next
        Position = Position + Len(Separator)
      Next
    End Sub
    Tu peux utiliser cette formule de cette manière: ConcatenateWithFormatText range("a1:a3"),range("a4"), chr(10) & "--" & chr(10)
    Nom : 2019-06-04_071747.png
Affichages : 419
Taille : 15,2 Ko


    Note toutefois que ce traitement (qui n'est normalement pas le boulot d'Excel) est très gourmand en temps.
    "Plus les hommes seront éclairés, plus ils seront libres" (Voltaire)
    ---------------
    Mes billets de blog sur DVP
    Mes remarques et critiques sont purement techniques. Ne les prenez jamais pour des attaques personnelles...
    Pensez à utiliser les tableaux structurés. Ils vous simplifieront la vie, tant en Excel qu'en VBA ==> mon tuto
    Le VBA ne palliera jamais une mauvaise conception de classeur ou un manque de connaissances des outils natifs d'Excel...
    Ce ne sont pas des bonnes pratiques parce que ce sont les miennes, ce sont les miennes parce que ce sont des bonnes pratiques
    VBA pour Excel? Pensez D'ABORD en EXCEL avant de penser en VBA...
    ---------------

  9. #9
    Inactif  

    Homme Profil pro
    cuisiniste
    Inscrit en
    Avril 2009
    Messages
    15 374
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Var (Provence Alpes Côte d'Azur)

    Informations professionnelles :
    Activité : cuisiniste
    Secteur : Bâtiment

    Informations forums :
    Inscription : Avril 2009
    Messages : 15 374
    Billets dans le blog
    8
    Par défaut re
    bonjour
    re
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    Si le VBA stockait les infos de mise en page en html
    si si pierre !! il stocke en html

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
     
    Debug.print range("A1:b2").Value(xlRangeValueXMLSpreadsheet)'arborescence et format(tout son thème)  ainsi que balise style si une propriété est entière dans la cellule a convertir 
    '
    debug.print range("A1:b2")..Value(xlRangeValueMSPersistXML)' sans formatage juste l'arborescence  en XML
    regarde dans les balise cells->data

    Nom : Capture.JPG
Affichages : 472
Taille : 288,0 Ko
    mes fichiers dans les contributions:
    mail avec CDO en vba et mail avec CDO en vbs dans un HTA
    survol des bouton dans userform
    prendre un cliché d'un range

    si ton problème est résolu n'oublie pas de pointer : : ça peut servir aux autres
    et n'oublie pas de voter

Discussions similaires

  1. Compter le nombre de lignes d'une source d'un formulaire?
    Par grenoult dans le forum VBA Access
    Réponses: 9
    Dernier message: 16/02/2018, 16h45
  2. [PDO] Compter le nombre de lignes d'une requête SELECT
    Par juJuv51 dans le forum PHP & Base de données
    Réponses: 3
    Dernier message: 02/02/2008, 13h49
  3. [PDO] Compter le nombre de lignes d'une requête SELECT
    Par WerKa dans le forum PHP & Base de données
    Réponses: 4
    Dernier message: 17/06/2007, 20h57
  4. Compter le nombre de lignes d'une requête sélection
    Par oceanediana dans le forum Requêtes et SQL.
    Réponses: 1
    Dernier message: 18/07/2006, 12h11
  5. Réponses: 4
    Dernier message: 05/05/2006, 23h52

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo