VBA : concaténation de cellules en changeant la police

[Nalrom]

Bonjour,

je n'ai pas réussi à trouver la réponse à ma question dans les différents forum.

J'ai un classeur avec 2 onglets "Planning" et "Macro Planning". Le but, c'est que le macro planning soit une extraction du planning pour les quelques jours à venir (msgbox pour choisir le nb de jour), avec les infos essentielles (date, nom de l'opération, équipe et n° de changement). Et j'aimerais que chaque élément apparaisse avec une couleur différente.

voici mon onglet planning (confidentialité oblige, les noms sont bidons^^) :


Avec ma macro, voici ce que j'obtiens dans l'onglet "Macro Planning" :


Et voici ce que j'aimerais obtenir :


Ma macro-excel (je vous fais grâce de la partie initialisation du tableau) :

    Dim DateJour As Date
    Dim NbJour As Integer
    Dim DebutCellule As Integer 'Définition du n° de ligne (pour la boucle for)
    Dim FinCellule As Integer 'Définition du nb de cellule (pour la limite de la boucle for)
    Dim operation As Variant
    Dim changement As Variant
    Dim equipe As Variant
    Dim environnement As Variant

For j = 2 To 2 + NbJour
        For i = DebutCellule To FinCellule
            If Sheets("Macro Planning").Range("A" & j).Value = Range("E" & i).Value Or Sheets("Macro Planning").Range("A" & j).Value = Range("F" & i).Value Then
                Set operation = Range("B" & i).MergeArea
                Set changement = Range("G" & i).MergeArea
                Set equipe = Range("D" & i).MergeArea
                Set environnement = Range("C" & i).MergeArea
                If environnement.Cells(1, 1).Value = "PP" Then
                    If Sheets("Macro Planning").Range("B" & j).Value = "" Then
                        Sheets("Macro Planning").Range("B" & j).Value = operation.Cells(1, 1).Value & " - " & equipe.Cells(1, 1).Value & " - " & changement.Cells(1, 1).Value
                    Else
                        Sheets("Macro Planning").Range("B" & j).Value = Sheets("Macro Planning").Range("B" & j).Value & Chr(10) & operation.Cells(1, 1).Value & " - " & equipe.Cells(1, 1).Value & " - " & changement.Cells(1, 1).Value
                    End If
                ElseIf environnement.Cells(1, 1).Value = "P" Then
                    Set ma = Range("B" & i).MergeArea
                    If Sheets("Macro Planning").Range("C" & j).Value = "" Then
                        Sheets("Macro Planning").Range("C" & j).Value = operation.Cells(1, 1).Value & " - " & equipe.Cells(1, 1).Value & " - " & changement.Cells(1, 1).Value
                    Else
                        Sheets("Macro Planning").Range("C" & j).Value = Sheets("Macro Planning").Range("C" & j).Value & Chr(10) & operation.Cells(1, 1).Value & " - " & equipe.Cells(1, 1).Value & " - " & changement.Cells(1, 1).Value
                    End If
                End If
            End If
        Next
    Next

Mon fichier est en PJ.

Par contre, je n'ai aucune idée de comment faire : passer par un tableau temporaire mis en forme et concaténer ensuite ? changer la couleur au fur et à mesure ? ...
Si quelqu'un a une réponse ou même une piste de réponse, je suis preneur.

Merci d'avance

 

[Modeste]

Re : VBA : concaténation de cellules en changeant la police

Bonsoir Nalrom,


4h30 plus tard ... toujours pas le bout d'une première piste (pourtant 30 personnes ont lu ton message) ... il doit donc y avoir quelque chose qui coince

• En essayant de m'y retrouver, ma première interrogation (si j'ai bien compris!?) serait: pourquoi aller se faire du mal, si ce n'est pas absolument indispensable
  (si tu réponds "juste par goût" tu n'es pas au bon endroit, essaie www.fais-moimaljohnnyjohnnyjohnny.aaargh)
  Posée autrement, ma question pourrait devenir: pourquoi ne pas subdiviser l'actuelle colonne "Preprod", ainsi que sa voisine de droite, en trois colonnes chacune? Il me semble que la mise en forme des caractères devrait s'en trouver simplifiée!?
• Par ailleurs, tu parles d'une macro avec msgbox pour choisir le nb de jour mais le code que tu joins ... ne semble pas correspondre (pas plus que les bouts de code dans le fichier)
• Le code dans ton message contient tellement de MergeArea que ça donne envie de fuir au plus vite (enfin, moi, en tout cas)
• Il y a bien, dans le Module4, quelque chose de lié à la mise en forme de caractères ... mais ce serait juste un test que tu as fait!?

Pour ce qui est de "je vous fais grâce de la partie initialisation du tableau" là, je crois que c'était une bonne idée, par contre

 

[mapomme]

Re : VBA : concaténation de cellules en changeant la police

Bonsoir Nalrom,

Un essai dans le fichier joint avec l'ajout à la fin de la macro Sub Macro_Planning() du code suivant :

Dim Lignes, Ligne, N&, xcell As Range
Sheets("Macro Planning").Select
For Each xcell In Range("a1").CurrentRegion.Offset(1, 1).Resize(Range("a1").CurrentRegion.Rows.Count - 1, 2)
  Lignes = Split(xcell, vbLf)
  N = 0
  For Each Ligne In Lignes
    i = InStr(Ligne, "-"): j = InStr(i + 1, Ligne, "-")
    If i > 0 Then
      If j > i Then
        xcell.Characters(N + i + 1, j - i - 2).Font.Color = RGB(0, 90, 170)
        xcell.Characters(N + j + 1, Len(Ligne) - j + 1).Font.Color = RGB(130, 60, 30)
      Else
        xcell.Characters(N + i + 1, Len(Ligne) - i + 1).Font.Color = RGB(0, 90, 170)
      End If
    End If
    N = N + Len(Ligne) + 1
  Next Ligne
Next xcell

Edit :

4h30 plus tard ....

5h00 plus tard .... Y'en a même certains qui s'y collent !
Bonjour Modeste