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

dindin

XLDnaute Occasionnel
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
 

dindin

XLDnaute Occasionnel
Merci pour votre réponse
voici mon objectif :
1617368551933.png

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

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

XLDnaute Barbatruc
Supporter XLD
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

XLDnaute Occasionnel
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 :
1617369893202.png
 

sylvanu

XLDnaute Barbatruc
Supporter XLD
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

XLDnaute Occasionnel
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

XLDnaute Barbatruc
Supporter XLD
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.
 

Discussions similaires

Membres actuellement en ligne

Statistiques des forums

Discussions
297 988
Messages
1 964 906
Membres
200 747
dernier inscrit
mtb60