Microsoft 365 différentes couleurs dans une cellule par vba

fanfanm · 29 Juillet 2021

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

vgendron · 29 Juillet 2021

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

fanfanm · 29 Juillet 2021

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

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

vgendron · 29 Juillet 2021

non pas beaucoup plus clair
mais, je me suis amusé:
1) remplir les mots à concaténer (Colonne A et Colonne C)
2) sur la colonne B ou D, selectionner la couleur voulue en cliquant sur le bouton "choisir couleur"

puis une fois que les couleurs sont définies, cliquer sur le bouton "Colorer"

patricktoulon · 29 Juillet 2021

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

patricktoulon · 29 Juillet 2021

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

fanfanm · 30 Juillet 2021

Merci pour vos réponse

je pense qu'avec ce qu'a fournis patricktoulon, je peux essayer de faire quelque chose qui correspond à ce que je veux faire.
Je vous tiendrai au courant.

fanfanm · 30 Juillet 2021

Du coup en bidouillant un peu, j'ai réussi à faire ce que je voulais. Merci encore pour vos réponses.

Effectuez une recherche sur Excel Downloads...

Microsoft 365 différentes couleurs dans une cellule par vba

fanfanm

XLDnaute Nouveau

patricktoulon

vgendron

XLDnaute Barbatruc

fanfanm

XLDnaute Nouveau

vgendron

XLDnaute Barbatruc

Pièces jointes

patricktoulon

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

fanfanm

XLDnaute Nouveau

fanfanm

XLDnaute Nouveau

Discussions similaires

Membres actuellement en ligne

Partager cette page

Tutos vidéos

Statistiques des forums