XL 2013 où me trompais-je?

patricktoulon

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
TooFatBoy
patricktoulon à dit:
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
Cliquez pour agrandir...
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.


patricktoulon à dit:
ilo n'y a pas quelque chose qui vous gêne là
Cliquez pour agrandir...
C'est la première des trois erreurs que j'ai expliquées en #4. ;)
Trier par date Trier par votes
patricktoulon

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 🤣
 
Vote positif 0 Vote négatif
TooFatBoy

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:
Vote positif 0 Vote négatif
patricktoulon

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
 
Vote positif 0 Vote négatif
sylvanu

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.
 
Vote positif 0 Vote négatif
TooFatBoy

TooFatBoy

XLDnaute Barbatruc
sylvanu à dit:
Peut être faudrait il supprimer l'arrondi sur les Px et l'introduire à la fin sur les valeurs de RGB.
Cliquez pour agrandir...
C'est même une certitude, sinon les erreurs d'approximation s'additionnent à chaque tour de boucle. ;)


Lolote83 à dit:
Je pense qu'il a trouvé le problème.
Cliquez pour agrandir...
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:
Vote positif 0 Vote négatif
patricktoulon

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à
 
Vote positif 0 Vote négatif
sylvanu

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
Vote positif 0 Vote négatif

Discussions similaires

Ferbank
  • Question
XL 2019 modifier une macro
Réponses
2
Affichages
744
Ferbank
Ferbank
A
  • Question
Insérer un copier / coller
Réponses
0
Affichages
183
aziz
A
S
  • Question
Microsoft 365 créer un macro vba
Réponses
0
Affichages
148
souhaib ad
S
A
  • Question
XL 2019 Vérifier si une ligne existe dans un autre fichier
Réponses
7
Affichages
463
A-F
A
PHV.FSM
  • Question
XL 2016 Calculer la position sur l'écran d'une position sur la grille (XL 2003)
2
Réponses
27
Affichages
3 K
Nico_J
Nico_J
D
  • Question
Microsoft 365 Modification d'un code VBA
Réponses
8
Affichages
657
Hasco
Hasco
U
  • Question
Autres Enregistrer sur Onglet TOTO
Réponses
2
Affichages
378
un internaute
U
P
  • Résolu(e)
Microsoft 365 calendrier compétition
2
Réponses
23
Affichages
1 K
ARMAEL
A
I
  • Question
XL 2016 Mon code VBA me renvoi une erreur
Réponses
6
Affichages
491
INFINITY100
I
A
  • Question
Microsoft 365 Cpier/coller en VBA
Réponses
7
Affichages
433
A-F
A

Membres actuellement en ligne

12 membres et 69 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 206
Messages
2 086 223
Membres
103 159
dernier inscrit
FBallea