Microsoft 365 différentes couleurs dans une cellule par vba

Créer une discussion
Répondre
  • Initiateur de la discussion Initiateur de la discussion fanfanm
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
F

fanfanm

XLDnaute Nouveau
Bonjour,

Je voudrais avoir deux mots dans une cellule de couleurs différentes.
Grossièrement, le code ressemblerait à ça :

A = "voiture"
couleur(A)=rouge

B = "de sport"
couleur(B) = vert

cellule(A1)= A & " " & B

Est-ce que c'est possible?
Merci
 
Solution
patricktoulon
Bonjour
je peux jouer moi aussi ???
VB: 
Sub test1()
    Dim Mots, couleurs
    Mots = Array("voiture", "de sport")    'l'array des mots
    couleurs = Array(vbRed, vbGreen)    'l'array des couleurs
    PutWordColorOnCell Mots, couleurs, Feuil1.[A4]    'appel de la fonction qui va faire le job
End Sub
'
Sub test2()
    Dim Mots, couleurs
    Mots = Array("toto", "titi", "riri", "fifi")    'l'array des mots
    couleurs = Array(vbRed, vbGreen, vbBlue, vbMagenta)    'l'array des couleurs
    PutWordColorOnCell Mots, couleurs, Feuil1.[A5]    'appel de la fonction qui va faire le job
End Sub
'
Sub test3()
    Dim Mots, couleurs
    Mots = Array("ca fait", "mal", "a la", "tete", "ce jargon")    'l'array des mots
    couleurs = Array(vbRed...
Trier par date Trier par votes
Bonjour

avec l'enregistreur de macro ca donne ca:
VB: 
Sub Macro1()
'
' Macro1 Macro
'

'
    Range("A6").Select
    ActiveCell.FormulaR1C1 = "Voiture de sport"
    Range("A6").Select
    ActiveCell.FormulaR1C1 = "Voiture de sport"
    With ActiveCell.Characters(Start:=1, Length:=0).Font
        .Name = "Calibri"
        .FontStyle = "Normal"
        .Size = 11
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With
    With ActiveCell.Characters(Start:=1, Length:=8).Font
        .Name = "Calibri"
        .FontStyle = "Normal"
        .Size = 11
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .Color = -16776961
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With
    With ActiveCell.Characters(Start:=9, Length:=8).Font
        .Name = "Calibri"
        .FontStyle = "Normal"
        .Size = 11
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .Color = -11480942
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With
    Range("A7").Select
End Sub

à adapter selon tes besoins dans ton fichier
 
Vote positif 0 Vote négatif
vgendron à dit:
Bonjour

avec l'enregistreur de macro ca donne ca:
VB: 
Sub Macro1()
'
' Macro1 Macro
'

'
    Range("A6").Select
    ActiveCell.FormulaR1C1 = "Voiture de sport"
    Range("A6").Select
    ActiveCell.FormulaR1C1 = "Voiture de sport"
    With ActiveCell.Characters(Start:=1, Length:=0).Font
        .Name = "Calibri"
        .FontStyle = "Normal"
        .Size = 11
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With
    With ActiveCell.Characters(Start:=1, Length:=8).Font
        .Name = "Calibri"
        .FontStyle = "Normal"
        .Size = 11
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .Color = -16776961
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With
    With ActiveCell.Characters(Start:=9, Length:=8).Font
        .Name = "Calibri"
        .FontStyle = "Normal"
        .Size = 11
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .Color = -11480942
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With
    Range("A7").Select
End Sub

à adapter selon tes besoins dans ton fichier
Cliquez pour agrandir...
Ce n'est pas vraiment l'effet recherché car ce que vous venez de faire est de récupérer du texte dans une cellule. Hors ce que je veux, c'est de mettre un texte à partir du code vba. Et ce texte est composé de deux mots différents.

A est un mot de longueur variable récupéré dans la cellule A2 (par exemple). Tandis que B est un texte enregistrer sur vba.

Donc si je reprend mon premier exemple plus précisément :
A = cellule(A2)
couleur(A) = rouge

B= "de sport"
couleur(B) = vert

cellule(A1) = A & " " & B

Je ne sais pas si c'est plus clair comme ça
 
Vote positif 0 Vote négatif
Bonjour
je peux jouer moi aussi ???
VB: 
Sub test1()
    Dim Mots, couleurs
    Mots = Array("voiture", "de sport")    'l'array des mots
    couleurs = Array(vbRed, vbGreen)    'l'array des couleurs
    PutWordColorOnCell Mots, couleurs, Feuil1.[A4]    'appel de la fonction qui va faire le job
End Sub
'
Sub test2()
    Dim Mots, couleurs
    Mots = Array("toto", "titi", "riri", "fifi")    'l'array des mots
    couleurs = Array(vbRed, vbGreen, vbBlue, vbMagenta)    'l'array des couleurs
    PutWordColorOnCell Mots, couleurs, Feuil1.[A5]    'appel de la fonction qui va faire le job
End Sub
'
Sub test3()
    Dim Mots, couleurs
    Mots = Array("ca fait", "mal", "a la", "tete", "ce jargon")    'l'array des mots
    couleurs = Array(vbRed, vbGreen, vbBlue, vbMagenta, vbYellow)    'l'array des couleurs
    PutWordColorOnCell Mots, couleurs, Feuil1.[A6]    'appel de la fonction qui va faire le job
End Sub
'
'
Function PutWordColorOnCell(wordArray, colorArray, cel As Range)
    Dim I&, X&
    cel = Join(wordArray)
    For I = LBound(wordArray) To UBound(wordArray)
        X = InStr(1, cel.Value, wordArray(I), vbTextCompare)
        cel.Characters(X, Len(wordArray(I))).Font.Color = colorArray(I)
    Next
End Function
les couleurs peuvent être exprimées dans l'array de toute les manières que l'on puisse le faire
rgb
long
hexa

demo7.gif
 
Dernière édition:
Vote positif 0 Vote négatif
Solution
allez une petite variante
on peut mettre
soit moins de couleurs que les mots( le reste de la valeur dans la cellule restera en noir)
soit le même nombre
si on veut du noir entre deux on met 0 dans l'item de l'array des couleurs
tout les exemples
VB: 
Sub test1()
    Dim Mots, couleurs
    Mots = Array("voiture", "de sport")    'l'array des mots
    couleurs = Array(vbRed, vbGreen)    'l'array des couleurs
    PutWordColorOnCell Mots, couleurs, Feuil1.[A4]    'appel de la fonction qui va faire le job
End Sub
'
Sub test2()
    Dim Mots, couleurs
    Mots = Array("toto", "titi", "riri", "fifi")    'l'array des mots
    couleurs = Array(vbRed, vbGreen, vbBlue, vbMagenta)    'l'array des couleurs
    PutWordColorOnCell Mots, couleurs, Feuil1.[A5]    'appel de la fonction qui va faire le job
End Sub
'
Sub test3()
    Dim Mots, couleurs
    Mots = Array("ca fait", "mal", "a la", "tete", "ce jargon")    'l'array des mots
    couleurs = Array(vbRed, vbGreen, vbBlue, vbMagenta, vbYellow)    'l'array des couleurs
    PutWordColorOnCell Mots, couleurs, Feuil1.[A6]    'appel de la fonction qui va faire le job
End Sub

Sub test4() '3 expressions et seulement les deux premieres couleurs
    Dim Mots, couleurs
    Mots = Array("moi j'aime pas ", "les couleurs", "ca pique les yeux")    'l'array des mots
    couleurs = Array(RGB(255, 100, 0), 1654236)   'l'array des couleurs
    PutWordColorOnCell Mots, couleurs, Feuil1.[A7]    'appel de la fonction qui va faire le job
End Sub

Sub test5() ' couleur une sur deux
    Dim Mots, couleurs
    Mots = Array("moi j'aime pas ", "les couleurs", "ca pique les yeux", "noir c'est noir il n'y a plus d'espoir")   'l'array des mots
    couleurs = Array(RGB(255, 100, 0), 0, 16534836, 0) 'l'array des couleurs
    PutWordColorOnCell Mots, couleurs, Feuil1.[A8]    'appel de la fonction qui va faire le job
End Sub
'
'
Function PutWordColorOnCell(wordArray, colorArray, cel As Range)
    Dim I&, X&, C&
    cel = Join(wordArray)
    For I = LBound(wordArray) To UBound(wordArray)
        X = InStr(1, cel.Value, wordArray(I), vbTextCompare)
       If I > UBound(colorArray) Then C = vbBlack Else C = colorArray(I)
       cel.Characters(X, Len(wordArray(I))).Font.Color = C
    Next
End Function
demo7.gif
 
Vote positif 0 Vote négatif
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

D
  • Résolu(e)
Microsoft 365 chercher une cellule de couleur rouge dans une colonne
Réponses
4
Affichages
314
sylvanu
sylvanu
A
  • Question Question
XL 2019 Mise en forme conditionnelle
Réponses
5
Affichages
554
wDog66
wDog66
anthoYS
  • Résolu(e)
XL 2019 Pourquoi ça ne colore pas de vert la cellule vu que ça commence par "avec" à gauche de F4 à F5 ?
Réponses
3
Affichages
74
anthoYS
anthoYS
jeanmi
  • Résolu(e)
XL 2010 Mise en forme d’un graphique spécifique
Réponses
6
Affichages
165
jeanmi
jeanmi
T
  • Question Question
XL 2021 Additionner la couleur du fond et la police de plusieurs cellule en vba
Réponses
7
Affichages
521
Tophe2
T
A
  • Résolu(e)
XL 2019 Remplacer un mot et ajouter une couleur
Réponses
7
Affichages
513
Attila451
A
Nicolas JACQUIN
  • Question Question
XL 2019 Gérer la descente d'une cellule colorer selon un timer
2 3 4
Réponses
56
Affichages
2 K
Rheeem
R
F
  • Question Question
Microsoft 365 Excel - Report des valeurs et détection de doublons
Réponses
7
Affichages
249
djidji59430
djidji59430
G
  • Résolu(e)
XL 2013 menu MFC
Réponses
12
Affichages
554
Gégé-45550
Gégé-45550
Yann71
  • Question Question
Microsoft 365 Compter le nombre de cellule mise en couleur avec MFC
2
Réponses
19
Affichages
1 K
job75
job75
B
  • Question Question
Microsoft 365 couleur cellule A1 suivant la protection de la feuille
Réponses
4
Affichages
118
bendv
B
anthoYS
  • Résolu(e)
XL 2019 colorer les différents aliments avec un code VB pour macro de ce genre ?
2
Réponses
16
Affichages
270
anthoYS
anthoYS
C
  • Question Question
Microsoft 365 je cherche un code excel pour copier la couleur d'une cellule, à toutes les cellules qui ont la même valeur dans mon tableau.
Réponses
1
Affichages
399
sylvanu
sylvanu
alexandre33260
  • Question Question
XL 2021 Fonction SI (enfin je crois)
Réponses
4
Affichages
127
alexandre33260
alexandre33260
Dudu2
  • Résolu(e)
XL 2021 Afficher une palette de 10 couleurs dans le ruban
3 4 5
Réponses
62
Affichages
1 K
patricktoulon
patricktoulon
Y
  • Résolu(e)
XL 2013 Bloquer la saisie dans une plage selon un critère
Réponses
6
Affichages
472
TooFatBoy
TooFatBoy
E
  • Résolu(e)
Microsoft 365 Fonction Si - Ne renvoie pas à la bonne référence
2
Réponses
22
Affichages
640
eoliv
E
M
  • Question Question
XL 2021 Gestion des couleurs histogramme
Réponses
2
Affichages
411
nat54
nat54
A
  • Résolu(e)
XL 2016 Colorer cellules suivant condition saisie texte en VBA
Réponses
5
Affichages
396
Al1_44
A
R
  • Question Question
XL pour MAC Action d'une formule conditionnelle dans une cellule en fonction de la couleur de cette cellule
2
Réponses
17
Affichages
560
rtlv17
R
Retour