Conserver les propriétés des cellules concaténées

Salut Pierre

Je te propose ton code Modifié ainsi :

liste = [D2]
For q = 3 To 31
With Cells(q, 4)
If .Value <> "" Then
liste = liste & ", " & .Value
NC = NC & "," & Len(.Value) + 1
DP = DP & "," & (Len(liste) - 1) - (Len(.Value) - 1)
L = Len(Cells(q, 1))
With Cells(q, 4).Characters(Start:=1, Length:=L).Font
CL = CL & "," & .ColorIndex
End With
End If
End With
Next q
t = 31
liste = "Mots à utiliser : " & liste
Cells(t, 2) = liste
Cells(t, 2).Activate
For i = 1 To UBound(Split(ActiveCell, ","))
With ActiveCell.Characters(Start:=Split(DP, ",")(i) + Len("Mots à
utiliser : "), Length:=Split(NC, ",")(i)).Font
.ColorIndex = Split(CL, ",")(i)
End With
Next

Je t'avoue ne pas comprendre l'utilité de ta ligne :

liste = [D2]

Mais je l'ai maintenu

Celà devrait convenir

Dis moi !!!!

FFO a écrit :

liste = [D2]
For q = 3 To 31
With Cells(q, 4)
If .Value <> "" Then
liste = liste & ", " & .Value
NC = NC & "," & Len(.Value) + 1
DP = DP & "," & (Len(liste) - 1) - (Len(.Value) - 1)
L = Len(Cells(q, 1))
With Cells(q, 4).Characters(Start:=1, Length:=L).Font
CL = CL & "," & .ColorIndex
End With
End If
End With
Next q
t = 31
liste = "Mots à utiliser : " & liste
Cells(t, 2) = liste
Cells(t, 2).Activate
For i = 1 To UBound(Split(ActiveCell, ","))
With ActiveCell.Characters(Start:=Split(DP, ",")(i) + Len("Mots à
utiliser : "), Length:=Split(NC, ",")(i)).Font
.ColorIndex = Split(CL, ",")(i)
End With
Next

Merci FFO pour le travail

Je t'avoue ne pas comprendre l'utilité de ta ligne :
liste = [D2]
Mais je l'ai maintenu

En fait, ma liste de mots commence en D2; je définis la variable "liste"
en lui donnant le 1er mot; j'aurais pu éliminer cette ligne et faire
varier q de 2 à 31

Pour le reste... chez-moi, rien ne se passe de spécial ou de différent;
tous les mots sont en noir :-(

Hélas !!

Cordialement,
Pierre F.

Rebonjour Pierre

Ne nous décourageons pas !!!!
J'ai réalisé ce code à mon travail et il semblait bien fonctionner
Ce ne fut pas le cas chez moi

Mistère mistère !!!!

Je te propose cette version corrigée :


liste = [D2]
For q = 3 To 31
With Cells(q, 4)
If .Value <> "" Then
liste = liste & ", " & .Value
NC = NC & "," & Len(.Value) + 1
DP = DP & "," & (Len(liste) - 1) - (Len(.Value) - 1)
L = Len(Cells(q, 4))
With Cells(q, 4).Characters(Start:=1, Length:=L).Font
CL = CL & "," & .ColorIndex
End With
End If
End With
Next q
t = 31
liste = "Mots à utiliser : " & liste
Cells(t, 2) = liste
Cells(t, 2).Activate
For i = 1 To UBound(Split(ActiveCell, ","))
With ActiveCell.Characters(Start:=Split(DP, ",")(i) + Len("Mots àutiliser :
") + 1, Length:=Split(NC, ",")(i)).Font
If Split(CL, ",")(i) <> -4105 Then
.ColorIndex = Split(CL, ",")(i)
End If
End With
Next

Celui-ci semble apporter le résutat escompté

Sur Ce lien un exemple que tu peux tester

Exécute la macro "Traitement"

Donnes moi ton avis sur le résultat !!!!


http://www.cijoint.fr/cjlink.php?file=cj200807/cijgJyEixP.xls

FFO a écrit :

Rebonjour Pierre

Ne nous décourageons pas !!!!

Non, ça va ! j'ai une totale confiance dans les ressources incroyables
de ce forum :-))

Je te propose cette version corrigée :

liste = [D2]
For q = 3 To 31
With Cells(q, 4)

[...]

End With
Next

Celui-ci semble apporter le résultat escompté

Super, merci infiniment! C'est tout à fait encourageant :-)

La démo jointe fonctionne très bien...
Mais pour mon fichier... (copier/coller tel quel) les mots rouges
ressortent bien de la bonne couleur sauf la dernière lettre qui reste en
noir ?

Cordialement,
Pierre F.

FFO a écrit :

DP = DP & "," & (Len(liste) - 1) - (Len(.Value) - 1)

Remplacé par:
DP = DP & "," & (Len(liste)) - (Len(.Value) - 1)

Oups, trouvé la bulle qui venait de mon fichier : chaque mot est précédé
d'un espace...
Tout fonctionne très bien!

Mille mercis encore!

Cordialement,
Pierre F.

Rebonjour Pierre

Heureux que celà fonctionne mieux

Pour la petite imperfection (dernier caractère qui reste noir) essaies de
jouer sur la ligne :

With ActiveCell.Characters(Start:=Split(DP, ",")(i) + Len("Mots àutiliser :
") + 1, Length:=Split(NC, ",")(i)).Font

Start et la position du début du mot à colorer
Length et le nombre de cactères à colorer

Normalement le 2° paramètres doit être correct

De plus si le défaut est identique sur chaque mot sachant qu'ils ont un
nombre de caractères différent seul le départ étant identique pour tous est à
incriminer

Donc je pense que le 1° paramètre est à mettre en cause

Il faut donc jouer sur le chiffre 1 de cette ligne :

Start:=Split(DP, ",")(i) + Len("Mots àutiliser : ") + 1

et mettre peut être

Start:=Split(DP, ",")(i) + Len("Mots àutiliser : ") + 2

Fais des essais et dis moi

Sinon Peux tu me transmettre ton fichier par le biais de ce site :

http://www.cijoint.fr/index.php

Communiques moi le lien pour le récupérer

Dans l'attente de te lire

FFO a écrit :

Pour la petite imperfection (dernier caractère qui reste noir) essaies de
jouer sur la ligne :
With ActiveCell.Characters(Start:=Split(DP, ",")(i) + Len("Mots àutiliser :
") + 1, Length:=Split(NC, ",")(i)).Font

Start et la position du début du mot à colorer
Length et le nombre de cactères à colorer

De plus si le défaut est identique sur chaque mot sachant qu'ils ont un
nombre de caractères différent seul le départ étant identique pour tous est à
incriminer

Donc je pense que le 1° paramètre est à mettre en cause
Il faut donc jouer sur le chiffre 1 de cette ligne :

Start:=Split(DP, ",")(i) + Len("Mots àutiliser : ") + 1
et mettre peut être
Start:=Split(DP, ",")(i) + Len("Mots àutiliser : ") + 2

Merci pour cette précision; pour l'instant lorsque je fais tourner la
macro sur une page, tout baigne à la perfection! :-))
Lorsque je l'intègre dans une autre macro pour traiter les 36 feuilles
de mon dossier... il y a quelques décalages dans la couleur; mais ils
sont très certainement liés à d'autres paramètres (nbre d'espaces,
points, virgules...)

Merci encore de m'avoir dépanné ce soir. Je vois le bout de ce projet
grâce à toi.

Cordialement,
Pierre F.