XL 2016 Adapter un code pour afficher les couleurs en RGB dans des textboxs

dindin · 2 Avril 2021

Bonjour le Forum

Depuis toute à l'heure j'essaye d'adapter ce code qui fonctionne très bien sur des cellules.
le code d'un développeur qui s'appelle Sébastien :

VB:

Sub apercus_rgb() 'Sébastien - Forum Excel-Pratique
     ligne = 0
    For r = 0 To 256 Step 32
        For g = 0 To 256 Step 32
            ligne = ligne + 1
            For b = 0 To 256 Step 32
                col = b / 32 + 1
                If r = 256 Then r = 255
                If g = 256 Then g = 255
                If b = 256 Then b = 255
                Cells(ligne, col) = r & ", " & g & ", " & b
                Cells(ligne, col).Interior.Color = RGB(r, g, b)
                If (r + g + b) / 32 < 7 Then Cells(ligne, col).Font.ColorIndex = 15
            Next
        Next
    Next
End Sub

Mon objectif c'est colorier mes textboxs à l'aide d'une nouvelle boucle
Voici le mien qui ne m'affiche une erreur :

Code:

For i = 1 To 729
    For r = 0 To 256 Step 32
        For g = 0 To 256 Step 32
           Controls("TextBox" & i) = 1
            For b = 0 To 256 Step 32
                col = b / 32 + 1
                If r = 256 Then r = 255
                If g = 256 Then g = 255
                If b = 256 Then b = 255
                Controls("TextBox" & i) = r & ", " & g & ", " & b
                Controls("TextBox" & i).BackColor = RGB(r, g, b)
                If (r + g + b) / 32 < 7 Then Controls("TextBox" & i).Font.ColorIndex = 15
            Next
        Next
    Next
    Next i

mes textboxs sont numérotés de 1 à 729

Merci pour votre aide

fanch55 · 2 Avril 2021

Bonjour,

Pour modifier la couleur de la police d'un TextBox, c'est .Forecolor et non pas .Font.ColorIndex .
Sinon, telle que la boucle est conçue, tous les textbox au final auront systématiquement un rgb=255,255,255

dindin · 2 Avril 2021

Merci pour votre réponse
voici mon objectif :

colorier les textbox suivants avec ces couleur afin de récupérer le code RGB se trouvant dans chaque cellule

Si vous pouvez m'aider
voici ma boucle qui ne fonctionne pas

VB:

Dim colonne As Integer, ligne As Integer, i As Integer
    
    'Valeur de la première cellule
    'valeur = 1
     For i = 1 To 729
    'Boucle des lignes
           For ligne = 1 To 81
        
        'Boucle des colonnes
             For colonne = 1 To 9
        
            
            
         Me.Controls("TextBox" & i).BackColor = Cells(ligne, colonne).Interior.Color
         'Controls("TextBox" & i).BackColor = RGB & Cells(ligne, colonne).Value
            'i = Cells(ligne, colonne).Value
'            valeur = valeur + 1 'Valeur incrémentée de 1
            
        Next
        
    Next
    
    Next i

sylvanu · 2 Avril 2021

Bonjour DinDin,
Si j'ai bien compris ce que vous vouliez faire, ça ne peux pas marcher.
Une fois "i" initialisé vous faites entièrement les 3 boucles rgb, donc vous sortez avec r,g,b=255, et vous recommencez la même chose avec i+1, donc les textbox sont toujours avec rgb=0.

Si le but est de donner à chaque textbox une couleur, j'aurais tenté ceci :

VB:

' init des couleurs
r = 0: g = 0: b = 0
For i = 1 To 729
    r = r + 32
    If r = 256 Then         ' si dépassement r alors r=0 et incrément g
        r = 0
        g = g + 32
        If g = 256 Then     ' si dépassement g alors g=0 et incrément b
            g = 0
            b = b + 32
        End If
    End If
    Controls("TextBox" & i) = r & ", " & g & ", " & b
    Controls("TextBox" & i).BackColor = RGB(r, g, b)
    If (r + g + b) / 32 < 7 Then Controls("TextBox" & i).Font.ColorIndex = 15
Next i

dindin · 2 Avril 2021

sylvanu à dit:
Bonjour DinDin,
Si j'ai bien compris ce que vous vouliez faire, ça ne peux pas marcher.
Une fois "i" initialisé vous faites entièrement les 3 boucles rgb, donc vous sortez avec r,g,b=255, et vous recommencez la même chose avec i+1, donc les textbox sont toujours avec rgb=0.

Si le but est de donner à chaque textbox une couleur, j'aurais tenté ceci :

VB:

' init des couleurs r = 0: g = 0: b = 0 For i = 1 To 729 r = r + 32 If r = 256 Then ' si dépassement r alors r=0 et incrément g r = 0 g = g + 32 If g = 256 Then ' si dépassement g alors g=0 et incrément b g = 0 b = b + 32 End If End If Controls("TextBox" & i) = r & ", " & g & ", " & b Controls("TextBox" & i).BackColor = RGB(r, g, b) If (r + g + b) / 32 < 7 Then Controls("TextBox" & i).Font.ColorIndex = 15 Next i

Merci pour ce code
par contre j'ai cette erreur :

sylvanu · 2 Avril 2021

Oups! le test sur b a été oublié. Sorry.

VB:

' init des couleurs
r = 0: g = 0: b = 0
For i = 1 To 729
    r = r + 32
    If r = 256 Then         ' si dépassement r alors r=0 et incrément g
        r = 0
        g = g + 32
        If g = 256 Then     ' si dépassement g alors g=0 et incrément b
            g = 0
            b = b + 32
        End If
        If b = 256 Then     ' si dépassement b alors b=0
            b = 0
        End If
    End If
    Controls("TextBox" & i) = r & ", " & g & ", " & b
    Controls("TextBox" & i).BackColor = RGB(r, g, b)
    If (r + g + b) / 32 < 7 Then Controls("TextBox" & i).Font.ColorIndex = 15
Next i

dindin · 2 Avril 2021

sylvanu à dit:

Oups! le test sur b a été oublié. Sorry.

VB:

' init des couleurs
r = 0: g = 0: b = 0
For i = 1 To 729
    r = r + 32
    If r = 256 Then         ' si dépassement r alors r=0 et incrément g
        r = 0
        g = g + 32
        If g = 256 Then     ' si dépassement g alors g=0 et incrément b
            g = 0
            b = b + 32
        End If
        If b = 256 Then     ' si dépassement b alors b=0
            b = 0
        End If
    End If
    Controls("TextBox" & i) = r & ", " & g & ", " & b
    Controls("TextBox" & i).BackColor = RGB(r, g, b)
    If (r + g + b) / 32 < 7 Then Controls("TextBox" & i).Font.ColorIndex = 15
Next i

désolé toujours la même erreur

sylvanu · 2 Avril 2021

Au pif, le texte d'une textbox c'est Forecolor et non Font.
On a les propriétés dans Propriétés de la textbox.
Sans fichier test difficile à dire, mais peut être que l'erreur est là.

dindin · 2 Avril 2021

sylvanu à dit:
Au pif, le texte d'une textbox c'est Forecolor et non Font.
On a les propriétés dans Propriétés de la textbox.
Sans fichier test difficile à dire, mais peut être que l'erreur est là.

Voici le fichier .
ce qui m'intéresse c'est le backcolor et non pas le foreColor du textbox
Merci encore une fois

dindin · 2 Avril 2021

dindin à dit:
Voici le fichier .
ce qui m'intéresse c'est le backcolor et non pas le foreColor du textbox
Merci encore une fois

vous avez raison il a fallu corriger la dernière ligne. Merci TOP ce code

sylvanu · 2 Avril 2021

Oui mais si vous mettez la ligne :

VB:

If (r + g + b) / 32 < 7 Then Controls("TextBox" & i).Font.ColorIndex = 15

en commentaire ça marche.
D'où ma qusetion sur Font.ColorIndex.

sylvanu · 2 Avril 2021

Qui plus est vous avez un bug dans le code :

Code:

        If g = 256 Then     ' si dépassement g alors g=0 et incrément b
            g = 0
            b = b + 32
        End If
        If b = 256 Then     ' si dépassement b alors b=0
            b = b + 32
        End If

C'est

Code:

        If g = 256 Then     ' si dépassement g alors g=0 et incrément b
            g = 0
            b = b + 32
        End If
        If b = 256 Then     ' si dépassement b alors b=0
            b = 0
        End If

Quand b=256 c'est b=0 et non b=b+32 sinon vous dépassez les 8 bits.

dindin · 2 Avril 2021

Merci beaucoup à vous deux

fanch55 · 3 Avril 2021

Post précédent supprimé :
Classeur joint pour visu

dindin · 3 Avril 2021

fanch55 à dit:
Post précédent supprimé :
Classeur joint pour visu

Un grand Merci fanch55
Joli travail

XL 2016 Adapter un code pour afficher les couleurs en RGB dans des textboxs

dindin

XLDnaute Occasionnel

fanch55

XLDnaute Barbatruc

dindin

XLDnaute Occasionnel

sylvanu

XLDnaute Barbatruc

dindin

XLDnaute Occasionnel

sylvanu

XLDnaute Barbatruc

dindin

XLDnaute Occasionnel

sylvanu

XLDnaute Barbatruc

dindin

XLDnaute Occasionnel

Pièces jointes

dindin

XLDnaute Occasionnel

sylvanu

XLDnaute Barbatruc

sylvanu

XLDnaute Barbatruc

dindin

XLDnaute Occasionnel

fanch55

XLDnaute Barbatruc

Pièces jointes

dindin

XLDnaute Occasionnel

Discussions similaires