XL 2013 où me trompais-je?

patricktoulon · 11 Décembre 2023

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

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

TooFatBoy · 11 Décembre 2023

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

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à

C'est la première des trois erreurs que j'ai expliquées en #4.

TooFatBoy · 11 Décembre 2023

patricktoulon à dit:
oui ok on est presque bon sauf le dernier

Non, dans ma dernière version, même le dernier est bon : l'erreur venait de tes déclarations de variables.

patricktoulon · 11 Décembre 2023

Hoh!!! non mais vraiment je suis une tronche de pied moi hein
c'est en regardant vos code que je m'en suit rendu compte
je pigeais pas pourquoi c'ettait différent chez moi

ilo n'y a pas quelque chose qui vous gêne là

VB:

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)

puré j'ai vraiment la tronche en bied moi
ha vous pouvez rire je vous accompagne même

TooFatBoy · 11 Décembre 2023

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

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à

C'est la première des trois erreurs que j'ai expliquées en #4.

patricktoulon · 11 Décembre 2023

bon ben ok
voila je prend le tien @TooFatBoy adapté

VB:

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

    nb = 20

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

    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)
        With Cells(i + 1, 1)
            .Interior.Color = RGB(rp, gp, bp)
            .Value = RGB(rp, gp, bp)
        End With
    Next i

    With Cells(1, 2): .Interior.Color = C1: .Value = C1: End With
    With Cells(nb, 2): .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) = Int(c / 65536)
    longToRGB = t
End Function

TooFatBoy · 11 Décembre 2023

Il y a un autre endroit où tu te trompes : c'est dans le titre de ce fil...
On n'écrit pas "où me trompais-je?", mais "Où me trompé-je ?".

OK, je sors et vite !

patricktoulon · 11 Décembre 2023

et moi avec ma puré de puré d'erreur plus grosse que moi
où me jetté-je?

patricktoulon · 11 Décembre 2023

re
pour finir j'ai ma table de couleur de base

VB:

Sub test()
    Set Rng = [A1:A20]
    With Rng: .Interior.Color = xlNone: .ClearContents: End With
    t = GetTableGradient(vbRed, vbGreen, Rng.Rows.Count)
    Rng.Value = Application.Transpose(t)
End Sub

Function GetTableGradient(c1&, c2&, nb&)
    Dim Cx1, Cx2, Px1, Px2, Px3, Tbl()
    ReDim Tbl(1 To nb)
    c1 = vbRed: Cx1 = longToRGB(c1): c2 = vbGreen: 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
        rp = Round(Cx1(1) + i * Px1)
        gp = Round(Cx1(2) + i * Px2)
        bp = Round(Cx1(3) + i * Px3)
        Tbl(i + 1) = RGB(rp, gp, bp)
    Next i
    GetTableGradient = Tbl
End Function

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

dysorthographie · 11 Décembre 2023

bonsoir Patrick

VB:

Type MyRgb
    R As Integer
    V  As Integer
    B As Integer
End Type

Sub test()
    Dim nb&, C1&, C2&, Cx1 As MyRgb, Cx2 As MyRgb, Px1&, Px2&, Px3&, Ecart As MyRgb
    
   nb = 20
    Cells(1, 1).Resize(nb, 2).Clear
   C1 = vbRed:  Cx1 = longToRGB(C1)
    C2 = vbGreen: Cx2 = longToRGB(C2)
    Ecart.R = (Cx2.R - Cx1.R) / nb: Ecart.V = (Cx2.V - Cx1.V) / nb: Ecart.B = (Cx2.B - Cx1.B) / nb
    Cx2 = Cx1
    For i = 1 To nb
    With Cx2
        If i <> 1 Then .R = .R + Ecart.R: .V = .V + Ecart.V: .B = .B + Ecart.B
      Cells(i, 1).Interior.Color = RGB(.R, .V, .B)
    End With
    Next
Cells(1, 2).Interior.Color = C1
Cells(nb, 2).Interior.Color = C2
 

End Sub
Function longToRGB(c) As MyRgb
   With longToRGB
        .R = c Mod 256
        .V = ((c - .R) / 256) Mod 256
        .B = Int(c / 65536)
  End With
End Function

patricktoulon · 11 Décembre 2023

Robert bonsoir

la dernière n'est pas bonne c'est normal tu degrève par la couleur 1 de nb

patricktoulon · 11 Décembre 2023

re
juste pour voir
voyez vous la différence

TooFatBoy · 11 Décembre 2023

patricktoulon à dit:
juste pour voir
voyez vous la différence

Le dégradé est plus fin, plus lisse, à droite.

dysorthographie · 11 Décembre 2023

oui tu as raison Patrick maintenant ça fonctionne

VB:

 Ecart.R = (Cx2.R - Cx1.R) / (nb - 1): Ecart.V = (Cx2.V - Cx1.V) / (nb - 1): Ecart.B = (Cx2.B - Cx1.B) / (nb - 1)

la ligne 1 est forcément = à C1

VB:

Type MyRgb
    R As Double
    V  As Double
    B As Double
End Type

Sub test()
    Dim nb&, C1&, C2&, Cx1 As MyRgb, Cx2 As MyRgb, Px1&, Px2&, Px3&, Ecart As MyRgb
    
   nb = 20
    Cells(1, 1).Resize(nb, 2).Clear
   C1 = vbRed:  Cx1 = longToRGB(C1)
    C2 = vbGreen: Cx2 = longToRGB(C2)
    Ecart.R = (Cx2.R - Cx1.R) / (nb - 1): Ecart.V = (Cx2.V - Cx1.V) / (nb - 1): Ecart.B = (Cx2.B - Cx1.B) / (nb - 1)
    Cx2 = Cx1
    For i = 1 To nb
    With Cx2
        If i <> 1 Then .R = .R + Ecart.R: .V = .V + Ecart.V: .B = .B + Ecart.B
      Cells(i, 1).Interior.Color = RGB(.R, .V, .B)
     Debug.Print Cells(i, 1).Interior.Color, i
    End With
    Next
Cells(1, 2).Interior.Color = C1
Cells(nb, 2).Interior.Color = C2

   Debug.Print Cells(1, 1).Interior.Color, Cells(nb, 1).Interior.Color, Cells(1, 2).Interior.Color, Cells(nb, 2).Interior.Color
End Sub
Function longToRGB(c) As MyRgb
   With longToRGB
        .R = c Mod 256
        .V = ((c - .R) / 256) Mod 256
        .B = Int(c / 65536)
  End With
End Function

patricktoulon · 11 Décembre 2023

TooFatBoy à dit:
Le dégradé est plus fin, plus lisse, à droite.

oui c'est ca @TooFatBoy

c'etait le but de l'operation
lisser un gradient sur une plage non fusionnée

patricktoulon · 11 Décembre 2023

re
et encore là dans la capture tu la vois saccadée mais ca n'est pas le cas en vrai

TooFatBoy · 11 Décembre 2023

patricktoulon à dit:
oui c'est ca @TooFatBoy

Chouette ça veut dire que ma cataracte n'est pas si prononcée que ça...

XL 2013 où me trompais-je?

patricktoulon

XLDnaute Barbatruc

TooFatBoy

TooFatBoy

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

TooFatBoy

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

TooFatBoy

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

dysorthographie

XLDnaute Accro

patricktoulon

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

TooFatBoy

XLDnaute Barbatruc

dysorthographie

XLDnaute Accro

patricktoulon

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

TooFatBoy

XLDnaute Barbatruc

Discussions similaires