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

Le
Pierre F.
Bonjour à toutes et tous

Dans un macro, j'ai le petit bout de code suivant qui me concatène une
colonne (D en l'occurrence) de mots "en ligne" et me place le résultat
dans la cellule B31

--
liste = [D2]
For q = 3 To 30
With Cells(q, 4)
If .Value <> "" Then
liste = liste & ", " & .Value
End If
End With
Next q

t = 31
liste = "Mots à utiliser : " & liste
Cells(t, 2) = liste
--

Quelques mots de la colonne D sont colorés, les autres sont en noir.
Dans la concaténation obtenue, je souhaiterais que ces couleurs soient
conservées.

Est-ce possible ?

Merci de votre aide

Cordialement,
Pierre F.
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
FFO
Le #16363491
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 !!!!
Pierre F.
Le #16363621
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.
FFO
Le #16365441
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
Pierre F.
Le #16365541
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.
Pierre F.
Le #16365661
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.
FFO
Le #16365651
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
Pierre F.
Le #16366711
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.
Publicité
Poster une réponse
Anonyme