[VBA / Excel]Ajouter texte dans cellule sans changer sa couleur Résolu/Fermé

Question

Bonjour, 

En fonction d'une condition dans mon code VBA, je veux rajouter du texte en rouge ou noir dans une cellule qui contient déjà du texte d'une certaine couleur. 
Je rajoute mon texte à la suite et je choisis la fonction Selection.Characters(position, longueur).Font.Color pour colorer la fin de mon texte rajouté.
Pour résumer la macro (qui est dans une maco bien plus grande)
Sub()
'Je dimensionne les variables
Dim Arajouter, CelluleCible, Position, Longueur
'J'affecte le texte dans chaque
Arajouter = "Texte à rajouter"
CelluleCible= Feuil1.Cells(1 , 1 )
'La position du texte avec la couleur a changer sera la longueur de la cellule avant rajout
Position = len(CelluleCible)
'La longueur du texte à colorer 
Longueur = len(Arajouter)
'On rajoute le texte à la fin
CelluleCible = CelluleCible + " " + Arajouter

'On change la couleur de ce que l'on a rajouté
Feuil1.Cells(1 , 1 ).Select
Selection.Characters(position + 1, longueur).Font.Color = -16776961

End Sub
 
Cependant j'ai l'impression que la couleur du texte avant est modifiée aussi en fonction de la couleur de ce que je rajoute.
Je voudrais rajouter le texte et modifier sa couleur sans que cela modifie la couleur du texte qui était déjà présent dans la cellule. 

Merci d'avance,

Michel

Configuration: Windows Vista / Firefox 35.0

ccm81 · Accepted Answer

OK, alors, il faut stocker les couleurs de chaque caractère avant la maj

Const coulss = 3

Public Sub essai()
Dim s As String, ls As Long, ss As String, lss As String, cel As Range
Dim tcoul(), k As Long
Set cel = Selection
s = cel.Value
ls = Len(s)
ss = InputBox("donner un texte")
lss = Len(ss)
ReDim tcoul(1 To ls + lss)
For k = 1 To ls
  tcoul(k) = cel.Characters(k, 1).Font.ColorIndex
Next k
For k = ls + 1 To ls + lss
  tcoul(k) = coulss
Next k
cel.Value = s & ss
For k = 1 To ls + lss
  cel.Characters(k, 1).Font.ColorIndex = tcoul(k)
Next k
End Sub
Cdlmnt

ccm81 · Answer

Bonjour, 

il te faut peut être récupérer la couleur de la première partie et l'appliquer aussi au résultat
exemple

Const coulss = 3

Public Sub essai()
Dim s As String, ls As Long, couls As Long, ss As String, lss As String, cel As Range
Set cel = Selection
s = cel.Value
couls = cel.Font.ColorIndex
ls = Len(s)
ss = InputBox("donner un texte")
lss = Len(ss)
cel.Value = s & ss
cel.Characters(1, ls).Font.ColorIndex = couls
cel.Characters(ls + 1, lss).Font.ColorIndex = coulss
End Sub
Cdlmnt

[VBA / Excel]Ajouter texte dans cellule sans changer sa couleur

2 réponses

Discussions similaires