XL 2013 où me trompais-je?

[patricktoulon]

Bonjour a tous
je voudrais comprendre ou je me trompe dans le raisonnement et par consequent dans le code
je veux faire un degradé de couleur de la couleur 1 à la couleur 2
j'ai un nombre de pas ici en l'ocurence 20
pour cela je récupère le (R,G,B) des deux couleurs
je calcule le pas de difference pour r g et b en negatif ou positif
et dans une boucle pour les test je colori les celulles de la ligne 1 a nb
en colonne 2 en ligne 1 et nb je met la couleur initiale
j'ai bien compris que si je veux garder mes deux couleurs initiales en ligne 1 et nb le pas je divise par nb-2
et bien j'ai pas mes couleurs tout du moins mon dégradé ne correspond pas à l'intention

heu je souhaiterais garder encore un momment mes cheveux
merci pour les retours

Sub test()
    Dim nb&, C1&, C2&, Cx1, Cx2, Px1&, Px2&, Px3&
   nb = 20
    Cells(1, 1).Resize(nb, 2).Clear
   C1 = vbRed: Cx1 = longToRGB(C1)
    C2 = vbGreen: Cx2 = longToRGB(C2)

    Px1 = Round(-(Cx1(1) - Cx2(1)) / (nb - 2))
    Px2 = Round(-(Cx1(2) - Cx2(2)) / (nb - 2))
    Px3 = Round(-(Cx1(3) - Cx2(3)) / (nb - 2))
   
    For i = 1 To nb
       rp = Cx1(1) + (Px1 * (i))
        gp = Cx1(2) + (Px2 * (i))
        bp = Cx1(3) + (Px3 * (i))
     
      Cells(i, 1).Interior.Color = RGB(Cx1(1) + rp, Cx1(2) + gp, Cx1(3) + bp)
    Next
Cells(1, 2).Interior.Color = C1
Cells(nb, 2).Interior.Color = C2
 

End Sub
Function longToRGB(c)
    Dim t(1 To 3)
    t(1) = c Mod 256
    t(2) = ((c - t(1)) / 256) Mod 256
    t(3) = ((c - t(1) - (t(2) * 256)) / 256 / 256) Mod 256
    longToRGB = t
End Function

 

[Lolote83]

Salut @patricktoulon
Il me semble que notre ami @sylvanu avait fait un truc dans ce genre que l'on retrouve dans le dossier "Fonction personnalisée VBA"

Voir ICI Dégradé couleur
Je n'ai pas encore testé ton code, mais je te ferais un retour dès que possible
Bon courage
@+ Lolote83

 

[patricktoulon]

re
oui bonsoir lolote83
des exemple il y a je sais mais je souhaite comprendre mon erreur
le tout fait tout maché c'est pas mon truc
moi même j'ai des vieux exemples que j'ai fait il y a des années et qui marchent très bien

on est pas dans la finalité de ce que je veux faire là
je l'etale sur une plage pour le visuel pendant le develloppement

en tout cas c'est une énigme pour moi
j'ai 2 colueur
je fait un degradé de 2 l'une vers l'autre sur 20 segments
j'en enleve 2 pour les couleurs initiales donc 18 pas
dans ces 18 pas je devrais avoir 18 segment de R et G et B à ecart egals
le second ayant la couleur1 - un ecart de pas
le dernier donc le 19 ème doit etre la couleur 2-un ecart de pas
enfin c'est mon raisonnement

 

[TooFatBoy]

Bonjour,

• L'erreur la plus importante semble être le calcul de rp, gp et bp, qui ne devrait pas inclure les Cx1(), ou alors dans la ligne suivante il ne faut pas inclure les Cx() dans le RGB().
• Il y aussi la division par (nb-2) au lieu de (nb-1).
• Il y a également la boucle FOR qui débute à 1 et crée donc un décalage.

Une proposition basée sur ton code :

Sub test()
'
Dim nb&, C1&, C2&, Cx1, Cx2, Px1&, Px2&, Px3&

    nb = 20
    Cells(1, 1).Resize(nb, 2).Clear
    C1 = vbRed: Cx1 = longToRGB(C1)
    C2 = vbBlue: Cx2 = longToRGB(C2)

    Px1 = Round(-(Cx1(1) - Cx2(1)) / (nb - 1))
    Px2 = Round(-(Cx1(2) - Cx2(2)) / (nb - 1))
    Px3 = Round(-(Cx1(3) - Cx2(3)) / (nb - 1))

    For i = 0 To nb - 1
        Cells(i + 1, 1).Interior.Color = RGB(Cx1(1) + i * Px1, Cx1(2) + i * Px2, Cx1(3) + i * Px3)
    Next i

    Cells(1, 2).Interior.Color = C1
    Cells(nb, 2).Interior.Color = C2

End Sub

Function longToRGB(c)
'
Dim t(1 To 3)

    t(1) = c Mod 256
    t(2) = ((c - t(1)) / 256) Mod 256
'    t(3) = ((c - t(1) - (t(2) * 256)) / 256 / 256) Mod 256
    t(3) = Int(c / 65536)
    longToRGB = t

End Function

 

[Lolote83]

Re bonjour à tous
@patricktoulon , j'ai récupéré les valeurs RGB de toutes les cellules et voici ce qu'il en ressort.
La première n'est pas la même que celle en colonne B, décalage. Donc peut être regarder de ce coté

 

[TooFatBoy]

Une prop en pj

 

[patricktoulon]

re
je reponds d'abords a lolote83
alors oui je l'ai remarqué
alors oui en effet sur 20 pas le 1er et le dernier doivent etre les deux couleurs donc je retire 2 pas comme je l'ai dit et je fait donc 18 pas la premiere couleur trouvé est donc la seconde etc...jusqu'a 19
alors j'ai bien trouvé le truc mais je le pige pas en fait
les ecart de pas etant calculés par le nombre de pas ça devrait matcher
là dans le code qui suit je calcule l'ecart r g b par le nombre de pas /2
et ça match
alors il y a une logique certainement mais qui m'échappe

Sub test()
    Dim nb&, C1&, C2&, Cx1, Cx2, Px1&, Px2&, Px3&
    nb = 20
    Cells(1, 1).Resize(100, 2).Clear
    C1 = vbRed: Cx1 = longToRGB(C1)
    C2 = vbGreen: Cx2 = longToRGB(C2)

    Px1 = Round(-(Cx1(1) - Cx2(1)) / ((nb - 2) / 2))
    Px2 = Round(-(Cx1(2) - Cx2(2)) / ((nb - 2) / 2))
    Px3 = Round(-(Cx1(3) - Cx2(3)) / ((nb - 2) / 2))

    For i = 1 To nb - 2
        rp = Cx1(1) + (Px1 * (i))
        gp = Cx1(2) + (Px2 * (i))
        bp = Cx1(3) + (Px3 * (i))

        With Cells(i + 1, 1)
            .Interior.Color = RGB(Cx1(1) + rp, Cx1(2) + gp, Cx1(3) + bp)
            .Value = .Interior.Color
        End With
    Next
    With Cells(1, 1): .Interior.Color = C1: .Value = C1: End With
    With Cells(nb, 1): .Interior.Color = C2: .Value = C2: End With


End Sub
Function longToRGB(c)
    Dim t(1 To 3)
    t(1) = c Mod 256
    t(2) = ((c - t(1)) / 256) Mod 256
    t(3) = ((c - t(1) - (t(2) * 256)) / 256 / 256) Mod 256
    longToRGB = t
End Function

et j'aime pas ne pas comprendre
merci lolote pour tes retours

 

[Lolote83]

Et la même copie d'écran avec le code donné par @TooFatBoy

Je pense qu'il a trouvé le problème.
@+ Lolote83

 

[patricktoulon]

re
je reponds a @p56 maintenant
1°il y a qu'une couleur (du plus clair au plus foncé c'est pas le theme de l'exercice )
2° ton calcul est interne aux cells donc sans celle tintandshade walouh walouh

 

[patricktoulon]

perso j'arrive à ça avec mon post #7

 

[sylvanu]

Bonsoir Patrick, Lolote, TooFatBoy,P56,
J'ai l'impression que cela pourrait venir du Round de Px1,Px2,Px3.
Si on fait 20 pas à partir de 255 avec soit un calcul exact, soit un calcul par arrondi, on trouve :

Peut être faudrait il supprimer l'arrondi sur les Px et l'introduire à la fin sur les valeurs de RGB.

 

[TooFatBoy]

Peut être faudrait il supprimer l'arrondi sur les Px et l'introduire à la fin sur les valeurs de RGB.

C'est même une certitude, sinon les erreurs d'approximation s'additionnent à chaque tour de boucle.

---

Je pense qu'il a trouvé le problème.

Pas tout à fait : il y a encore un bug...

J'ai trouvé la dernière erreur : c'est la définition des variables Px avec un & à la fin, qui fausse les calculs.

---

Donc au final ça donne ça :

Sub test()
'
Dim nb&, C1&, C2&, Cx1, Cx2, Px1, Px2, Px3

    nb = 20

    Columns("A:B").Interior.Color = xlNone

    C1 = vbRed: Cx1 = longToRGB(C1)
    C2 = vbGreen: Cx2 = longToRGB(C2)

    Px1 = (Cx2(1) - Cx1(1)) / (nb - 1)
    Px2 = (Cx2(2) - Cx1(2)) / (nb - 1)
    Px3 = (Cx2(3) - Cx1(3)) / (nb - 1)

    For i = 0 To nb - 1
        rp = Round(Cx1(1) + i * Px1)
        gp = Round(Cx1(2) + i * Px2)
        bp = Round(Cx1(3) + i * Px3)
        Cells(i + 2, 1).Interior.Color = RGB(rp, gp, bp)
    Next i

    Cells(2, 2).Interior.Color = C1
    Cells(nb + 1, 2).Interior.Color = C2

End Sub

Function longToRGB(c)
'
Dim t(1 To 3)

    t(1) = c Mod 256
    t(2) = ((c - t(1)) / 256) Mod 256
    t(3) = Int(c / 65536)
    longToRGB = t

End Function

---

Prop en pj

• Mettre en A1 le nombre de cellules désiré,
• mettre en H1 la couleur de départ désirée,
• mettre en J1 la couleur d'arrivée désirée,
• cliquer sur le bouton [Go !].

 

[patricktoulon]

RE
Bonsoir @sylvanu j'ai déjà essayé et visuellement ça change pas grand chose
non ce que je pige pas c'est le besoins de diviser par 2

    Px1 = Round(-(Cx1(1) - Cx2(1)) / ((nb - 2) / 2))
    Px2 = Round(-(Cx1(2) - Cx2(2)) / ((nb - 2) / 2))
    Px3 = Round(-(Cx1(3) - Cx2(3)) / ((nb - 2) / 2))

c'est en dehors de ma pigelette là

 

[patricktoulon]

je réponds a @TooFatBoy
mille excuses j'avais pas vu ta réponse
oui ok on est presque bon sauf le dernier

par contre là encore une enigme
avec les même calculs tu obtiens un dégradé différent puisque moi au millieur je passe par un jaune

 

[sylvanu]

Re,
J'ai retiré le round, et mis ce round à la fin, on obtient bien la gamme complète.

Sub test()
'
Dim nb&, C1&, C2&, Cx1, Cx2, Px1, Px2, Px3 ' Retypage des Px
    nb = 20
    Cells(1, 1).Resize(nb, 2).Clear
    C1 = vbRed: Cx1 = longToRGB(C1)
    C2 = vbBlue: Cx2 = longToRGB(C2)

    Px1 = -(Cx1(1) - Cx2(1)) / (nb - 1)
    Px2 = -(Cx1(2) - Cx2(2)) / (nb - 1)
    Px3 = -(Cx1(3) - Cx2(3)) / (nb - 1)

    For i = 0 To nb - 1
        Cells(i + 1, 1).Interior.Color = RGB(Round(Cx1(1) + i * Px1), Round(Cx1(2) + i * Px2), Round(Cx1(3) + i * Px3))
        Cells(i + 1, 3) = Round(Cx1(1) + i * Px1)
        Cells(i + 1, 4) = Round(Cx1(2) + i * Px2)
        Cells(i + 1, 5) = Round(Cx1(3) + i * Px3)
    Next i

    Cells(1, 2).Interior.Color = C1
    Cells(nb, 2).Interior.Color = C2

End Sub