Définir une couleur pour chaque texte

Bonjour à tous,

Pour définir une couleur spécifique pour chaque texte donnée, j'aimerais utilisé un tableau à deux dimensions :

    ArrCoul = Array("Ré"=>RGB(146,208,80) _
                                       "CM"=>RGB(146,208,80) _
                                       "FO"=>RGB(146,208,80))

Mais cette syntaxe n'est pas prise par VBA.

Une solution ?

Merci d'avance.

Bonjour

Je ne sais pas pas (en plus je ne connais pas tout), si l'on peut initialiser un tableau à 2 dimensions comme cela

Exceptionnellement j'utilise des tableaux de tableaux mais leurs utilisation est un peu spéciale

Sinon 1 (non) 3 moyens simples

Dans une page tu copies sur 2 colonnes le nom et la valeur de la couleur et dans ta macro tu charges le tableau (grande facilité de modification)

ou

Tu fais 2 tableaux

Un avec les noms : ArrNom= Array("Ré", "CM", "FO")

Un autre avec les couleurs : ArrCoul = Array(RGB(146, 208, 80), RGB(146, 208, 80), RGB(146, 208, 80))

Et quand tu veux colorier tu recherches le nom dans le 1er et l'indice te donne la couleur dans le second

ou

Un seul tableau que tu parcours de 2 en 2 pour trouver le nom et l'indice + 1 te donne la couleur

ArrCoul = Array("Ré", RGB(146, 208, 80), "CM", RGB(146, 208, 80), "FO", RGB(146, 208, 80))

Banzai64 a écrit :

ArrNom= Array("Ré", "CM", "FO")
ArrCoul = Array(RGB(146, 208, 80), RGB(146, 208, 80), RGB(146, 208, 80))

tu peux aussi rajouter une instruction supplémentaire qui crée le tableau à 2 dimensions

ArrNomCoul = array(ArrNom,ArrCoul)

Bonjour Banzai64, h2so4,

Merci pour vos réponses.

Mais comment chercher un mot dans un tableau ?

Select Case Limite
Case "CAI", "CM", "FO"
    'Chercher le mot correspondant
    '....
    'Colorie les cellules correspondante
    With .Range(.Cells(Ligne, Col), .Cells(Ligne, DerCol))
        .Value = Limite    'TexteCellule
        .Interior.Color = RGB(231, 253, 191)    'CouleurCellule
    End With
Case "CAO", "CE", "RC", "L"
    'Chercher le mot correpondant
    '....
    'Colorie les cellules correspondante
    With .Range(.Cells(Ligne, Col), .Cells(Ligne, DerCol))
        .Value = Limite    'TexteCellule
        .Interior.Color = RGB(231, 253, 191)    'CouleurCellule

    End With
End Select

Bonjour

@ h2so4

Cela correspond à un tableau de tableaux

apt a écrit :

Mais comment chercher un mot dans un tableau ?

Une solution consiste à parcourir tout le tableau et à comparer avec ta recherche

Bonjour,

J'ai un essai, mais je devrais convertir la chaine, par exemple "RGB(146,208,80)" en RGB(143,208,80), c-à-d enlever les guillemets

Sub TestCouleur()
    Dim ArrCoul()
    Dim i As Integer, Elm As Integer
    Dim Ligne As Integer, Col As Integer, DerCol As Integer
    Dim Limite As String

    ArrCoul = Range("J1:K11")
    Limite = [D1]: Ligne = 6: Col = 1: DerCol = 8

    With Sheets("Feuil1")
        Select Case Limite
        Case "CAI", "CM", "FO"
            'Chercher le mot correspondant
            Elm = FindInArray(ArrCoul, Limite)
            'Coloriage des cellules correspondantes
            With .Range(.Cells(Ligne, Col), .Cells(Ligne, DerCol))
                .value = Limite    'TexteCellule
                .Interior.Color = ArrCoul(Elm, 2)   'CouleurCellule
            End With
        Case "CAO", "CE", "RC", "L"
            'Chercher le mot correspondant
            Elm = FindInArray(ArrCoul, Limite)
            'Coloriage des cellules correspondantes
            With .Range(.Cells(Ligne + 1, Col), .Cells(Ligne + 1, DerCol))
                .value = Limite    'TexteCellule
                .Interior.Color = ArrCoul(Elm, 2)   'CouleurCellule
            End With
        End Select
    End With
End Sub

Bonjour

Tu te compliques la vie

A voir

Bonjour Banzai64,

Merci pour cette nouvelle proposition.

Mais y a-t-il une formule qui convertit les valeurs RGB dans la colonne L en nombre dans la colonne K ?

Bonsoir

Une formule je ne sais pas

A1 : composante Rouge

B1 : Composante Verte

C1 : Composante Bleue

En D1

=(A1*2^16)+(B1*2^8)+C1

Bonsoir,

Je ne sais pas pourquoi cette formule ne donne pas le même résultat que celui dans ton dernier fichier joint.

Par exemple :

RGB(153,204,255) donne 16764057 dans le fichier joint.

Avec la formule proposée ça donne : 10079487.

Bonjour

Oui j'ai vu ça

Mais ce n'est pas moi qui calcule ces valeurs

Regardes le code dans le module2

Je n'en sais pas plus

Bonjour Banzai64,

J'ai trouvé.

La formule pour convertir le code RGB en décimal, se fait comme suit :

=R + (G*2^8) + (B*2^16)

Le code la fonction suivante utilse cette formule, mais j'ai une erreur lors de l'appel de cette dernière :

Objet requis

Sur la ligne :

TrouveCoul (Range("L1"))

Code de la fonction :

Function TrouveCoul(Cl As Range) As Long
    Dim R As Long, G As Long, B As Long, C() As String
    C = Split(Cl.value, ",")
    R = C(0): G = C(1): B = C(2)
    Debug.Print "R=" & R
    Debug.Print "G=" & G
    Debug.Print "B=" & B
    TrouveCoul = R + (G * 256) + (B * 65536)
    Debug.Print "TrouveCoul : " & TrouveCoul
    Cl.Interior.Color = TrouveCoul
End Function

Sub AppRGB()
    TrouveCoul (Range("L1"))
End Sub

Les trois valeurs RGB sont saisies dans une même cellule de la sorte :

230,240,60

Bonjour apt,

Essaie comme cela

Function TrouveCoul(Cl As Range) As Long
    Dim R As Long, G As Long, B As Long, C() As String
    C = Split(Cl.Value, ",")
    R = C(0): G = C(1): B = C(2)
    TrouveCoul = R + (G * 256) + (B * 65536)
End Function
Sub AppRGB()
    Range("L1").Interior.Color = TrouveCoul(Range("L1"))
End Sub

A+

Bonjour frangy,

Merci pour la rectification

Ça marche.