XL 2013 où me trompais-je?

patricktoulon

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

1702312962753.png

VB:
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
 
Solution
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
Pourtant j'utilise ton code, simplement corrigé au niveau de la définition des variables, du calcul des Px, et du calcul des rp, gp et bp.



ilo n'y a pas quelque chose qui vous gêne là
C'est la première des trois erreurs que j'ai expliquées en #4. ;)

patricktoulon

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

XLDnaute Barbatruc
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 :
VB:
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
 
Dernière édition:

patricktoulon

XLDnaute Barbatruc
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
VB:
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 :oops:
merci lolote pour tes retours
 

sylvanu

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

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

TooFatBoy

XLDnaute Barbatruc
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 :
VB:
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 !].
 

Pièces jointes

  • Degrade.xlsm
    26.1 KB · Affichages: 1
Dernière édition:

patricktoulon

XLDnaute Barbatruc
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
VB:
    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à
 

sylvanu

XLDnaute Barbatruc
Supporter XLD
Re,
J'ai retiré le round, et mis ce round à la fin, on obtient bien la gamme complète.
VB:
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
 

Pièces jointes

  • RGB.xlsm
    15.6 KB · Affichages: 2

Statistiques des forums

Discussions
313 288
Messages
2 096 843
Membres
106 762
dernier inscrit
geraldged19780604