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

Signaler
-
 MReb -
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

2 réponses

Messages postés
9579
Date d'inscription
lundi 18 octobre 2010
Statut
Membre
Dernière intervention
16 octobre 2020
1 926
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
3
Merci

Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire

CCM 60511 internautes nous ont dit merci ce mois-ci

Salut,

Désolé pour la réponse tardive, ça m'a pris pas mal de temps à proprement l'intégrer dans ma macro de base mais la méthode fonctionne très bien et ne rallonge pas trop le temps de fonctionnement.

Merci beaucoup !
Messages postés
9579
Date d'inscription
lundi 18 octobre 2010
Statut
Membre
Dernière intervention
16 octobre 2020
1 926
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
Salut ccm81,
Merci, cela marche dans certains cas.
Le problème est que le rajout de texte d'une certaine couleur se fait dans une boucle en fonction de conditions et que l'objectif est que seules certaines parties soit d'une certaine couleurs : Par exemple si on a 4 mots à rentrer on veut peut être (en fonction de boucles if) que 2 soient en rouge, 2 en noirs et peut être en alterné (j'aurais du le préciser dans ma question)
Au moment où on rajouterait donc du texte on pourrait se retrouver dans le cas où la cellule comporte déjà plusieurs mots de différentes couleurs.
Je pensais qu'il y aurait peut être un moyen de désactiver le fait que la cellule prenne automatiquement la couleur des caractères rajoutés.

Cordialement,