Discussion :

[patricktoulon]

re
Bonjour PMo
très belle approche

mais il y a un mais
je voudrais partir d'une couleur de base allons y le rose OK

mais je voudrais démarrer a presque blanc c'est a dire tinandshade 0.1( le plus clair )

incrémenter la boucle pendant 7 items et m'arrêter la car après la couleur est trop foncée et comme j'aurais du texte dans la cellule ca risque d'être gênant
ca c'était un premier point


cela dit je cherche aussi a faire le tour complet de la couleur du noir jusqu'au blanc en passant par la couleur ou l'inverse comme tu veux

donc ta version commence a la couleur
il faudrait trouver la fonction qui me la ramène a presque blanc et ensuite incrémenter avec 16 ou un de ces multiples pour arriver a presque noir

le multiple plus ou moins grand réduirait le nombre d'items

mais je pense y arriver avec ta méthode: ajouter d'abord a r,g,b 16 * X avant de boucler non?

[PMO2017]

Alors peur être comme cela

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
Sub bb()
Const FACTEUR_FONCE As Integer = 20 'plus la constante est grande, moins on fonce (et réciproquement)
Dim C As Range
Dim R%
Dim G%
Dim B%
Dim Couleur&
Dim i&
'---
Couleur& = ActiveCell.Interior.Color
Set C = ActiveCell
R% = CInt(Couleur& Mod 256)
G% = CInt((Couleur& Mod 65536) / 256)
B% = CInt(Couleur& / 65536)
'--- Force la couleur plus claire ---
R% = R% \ 2
G% = G% \ 2
B% = B% \ 2
Do
  R% = R% + 1
  G% = G% + 1
  B% = B% + 1
Loop Until R% = 235 Or G% = 235 Or B% = 235
C.Interior.Color = RGB(R%, G%, B%)
'---
For i& = 1 To 6
  R% = R% - (R% \ FACTEUR_FONCE)
  G% = G% - (G% \ FACTEUR_FONCE)
  B% = B% - (B% \ FACTEUR_FONCE)
  C.Offset(0, i&).Interior.Color = RGB(R%, G%, B%)
Next i&
End Sub

[patricktoulon]

je pense avoir trouvé mon truc

j'ai changer le signe - pour +

et effectivement je vais vers le plus clair
je trouve plein de chose étonnantes
j'ai mis dans la cellule a cote les nombre correspondant a R,G,B
et je me trouve souvent avec des nombre au dessus de 255
ca c'est un premier point
le 2 Emme point je constate aussi qu'il suffit que r arrive a 255 ou plus pour que la couleur soit blanche c'est assez etonnant quand meme

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Sub aa()
Const FACTEUR_FONCE As Integer = 128
Dim C As Range
Dim R%
Dim G%
Dim B%
Dim Couleur&
Dim i&
'---
Couleur& = ActiveWorkbook.Colors(34)
Set C = ActiveCell
R% = CInt(Couleur& Mod 256)
G% = CInt((Couleur& Mod 65536) / 256)
B% = CInt(Couleur& / 65536)
 
For i& = 1 To 20
  R% = R% + (R% \ FACTEUR_FONCE)
  G% = G% + (G% \ FACTEUR_FONCE)
  B% = B% + (B% \ FACTEUR_FONCE)
  Cells(i, 1).Interior.Color = RGB(R%, G%, B%)
Cells(i, 2) = R & "," & G & "," & B
Next i&
End Sub

je suis surpris par le comportement de la macro ?

donc pour partir du presque blanc
il faudrait que je fasse

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
multiple=255-R/16
r= (r+(r/facteur))*multiple

et pareil pour G et B
non?

EDIT:on a eu la même idée sauf que je vais essayer de le faire sans boucle c'est plus rigolo

en testant R,G,B par son multiple de 16 pour trouver mon multiple
on prendrait le plus petit des trois pour démarrer

[gnain]

Bonjour,
essaie ça
du blanc au noir
pour la couleur magenta

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
Sub couleur_TintAndShade()
 
couleur = ActiveWorkbook.Colors(7)
 
    R = couleur Mod 256
    G = (couleur \ 256) Mod 256
    B = (couleur \ 256 \ 256) Mod 256
 
k = 1
For i = 1 To 0 Step -0.1
 
    G = Round(255 * i)
 
    couleur = RGB(R, G, B)
    Cells(k, 1).Interior.Color = couleur
    k = k + 1
Next
 
 
For j = 1 To 0 Step -0.1
 
    R = Round(255 * j)
    B = Round(255 * j)
 
    couleur = RGB(R, G, B)
    Cells(k, 1).Interior.Color = couleur
    k = k + 1
Next

[patricktoulon]

yes !!!!
Aujourd'hui c'est PMO qui gagne

voila ma version
il suffit de changer le multiple de 16 en haut de macro pour avoir plus fonceé rapidement

et changer 6 pour X pour un dégradé plus progressif
j'ai trouver le moyen de demarer au plus clair sans boucle

ca c'est de la balle

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
Sub aa()
    Const FACTEUR_FONCE As Integer = 32' plus le multiple est petit plus on va vers le foncé
    Dim C As Range
    Dim R%
    Dim G%
    Dim B%
    Dim Couleur&
    Dim i&
    '---
    Couleur& = ActiveWorkbook.Colors(34)' choisissez la couleur que vous voulez 
    Set C = ActiveCell
    R% = CInt(Couleur& Mod 256)
    G% = CInt((Couleur& Mod 65536) / 256)
    B% = CInt(Couleur& / 65536)
    RM = 255 - R
    GM = 255 - G
    BM = 255 - B
    maxi = WorksheetFunction.Max(RM, GM, BM)
    R% = R% + maxi
    G% = G% + maxi
    B% = B% + maxi
    For i& = 1 To 6' on augmente le 6 pour avoir un degradé plus progressif en adaptant le multiple en haut de macro 
        R% = R% - (R% \ FACTEUR_FONCE)
        G% = G% - (G% \ FACTEUR_FONCE)
        B% = B% - (B% \ FACTEUR_FONCE)
        Cells(i, 1).Interior.Color = RGB(R%, G%, B%)
        Cells(i, 2) = R & "," & G & "," & B
    Next i&
End Sub

gnain je regarde ton magenta

PMO

gnain ta macro marche très bien pour le magenta uniquement

on pourrait rectifier ce point en décidant avant la 1 erre boucle le quel de R,G ou B devrait passer dans la première boucle

encore une fois en choisissant le nombre le plus important tout simplement

gnain j'ai repris ta version mais je pense qu'il manque des conditions au cas ou on aurait 2 valeur identiques

il faudrait alors comparer l'index de couleur ce qui implique l'utilisation des 56 couleurs uniquement
regarde ca et voit si tu peut ajouter les condition doubles
mais pour le moment seule la version de PMO fonctionne parfaitement bien avec n'importe quelle couleur par son long ou par son index

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
Sub couleur_TintAndShade()
    Couleur = ActiveWorkbook.Colors(26)
    R = Couleur Mod 256
    G = (Couleur \ 256) Mod 256
    B = (Couleur \ 256 \ 256) Mod 256
    If R < G Or R < B Or R = 0 Then coul = "rouge"
    If G < R Or G < B Or G = 0 Then coul = "green"
    If B < R Or B < G Or B = 0 Then coul = "bleu"
    MsgBox coul
    k = 1
    For i = 1 To 0 Step -0.1
        Select Case coul
        Case "rouge"
            R = Round(255 * i)
        Case "bleu"
            B = Round(255 * i)
        Case "green"
            G = Round(255 * i)
        End Select
 
        Couleur = RGB(R, G, B)
        Cells(k, 1).Interior.Color = Couleur
        k = k + 1
    Next
 
    For j = 1 To 0 Step -0.1
        Select Case coul
        Case "rouge"
            G = Round(255 * j)
            B = Round(255 * j)
        Case "bleu"
            R = Round(255 * j)
            G = Round(255 * j)
        Case "green"
            R = Round(255 * j)
            B = Round(255 * j)
        End Select
 
        Couleur = RGB(R, G, B)
        Cells(k, 1).Interior.Color = Couleur
        k = k + 1
    Next
End Sub

Edit: n'empeche qu'elle vous font bosser mes questions tordues hein!!!!!!!!!

[gnain]

Bonjour,
maintenant ça fonctionne sur toute les indexcolor

il suffit de changer le indexcolor dans ActiveWorkbook.Colors(5)

ce sont les mêmes couleur qu'avec TintAndShade

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
Sub couleur_TintAndShade222()
 
Couleur = ActiveWorkbook.Colors(5)
 
    R = Couleur Mod 256
    G = (Couleur \ 256) Mod 256
    B = (Couleur \ 256 \ 256) Mod 256
 
k = 1
For i = 0.9 To 0 Step -0.1
 
    If R <> 255 Then R = Round(255 * i)
    If G <> 255 Then G = Round(255 * i)
    If B <> 255 Then B = Round(255 * i)
 
    Couleur = RGB(R, G, B)
    Cells(k, 1).Interior.Color = Couleur
    k = k + 1
Next
 
For j = 0.9 To 0 Step -0.1
 
    If R <> 0 Then R = Round(255 * j)
    If G <> 0 Then G = Round(255 * j)
    If B <> 0 Then B = Round(255 * j)
 
    Couleur = RGB(R, G, B)
    Cells(k, 1).Interior.Color = Couleur
    k = k + 1
Next
End Sub

[patricktoulon]

on a eu a peu près la même idée ca fonctionne c'est bon

bein.... d'ici demain je vais bien vous en trouver une autre de question tordues fait moi confiance pour ca

bien que si on respecte une certaine logique dans ton raisonnement
on devrait plutôt faire ceci:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
For i = 0.9 To 0 Step -0.1
 
    If R < 255 Then R = Round(255 * i)
    If G < 255 Then G = Round(255 * i)
    If B < 255 Then B = Round(255 * i)
 
    Couleur = RGB(R, G, B)
    Cells(k, 1).Interior.Color = Couleur
    k = k + 1
Next
 
For j = 0.9 To 0 Step -0.1
 
    If R > 0 Then R = Round(255 * j)
    If G > 0 Then G = Round(255 * j)
    If B > 0 Then B = Round(255 * j)
 
    Couleur = RGB(R, G, B)
    Cells(k, 1).Interior.Color = Couleur
    k = k + 1
Next

et quoi que tu demontre un sacré bug logique ici

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
For i = 0.9 To 0 Step -0.1
 
    If R < 255 Then R = Round(255 * i)
    If G < 255 Then G = Round(255 * i)
    If B < 255 Then B = Round(255 * i)
 
    Couleur = RGB(R, G, B)
    Cells(k, 1).Interior.Color = Couleur
    k = k + 1
Next

ce qui implique que si je demarre avec une couleur par exemple
rgb(80,55,136)
dans ta boucle a chaque itération tu les met tous a l'identique
soit premier tour
rgb (229,229,229)
2 eme tour
rgb(204,204,204,
etc... jusqu'à 1
en aucun cas la couleur devrait être respectée puisque tu égalise les 3 des le 1 er tours

[patricktoulon]

re
c'est bien ce que je pensait quand on sort de la palette 56 couleur ca ne fonctionne plus

c'est par ce qu'il en faut au moins 1 des trois (r,g ou b) qui faut qu'il soit a 255

si je fait par exemple couleur=rgb(186,56,164) donc couleur en dehors de la palette ca ne fonctionne plus
POURTANT!!!!!!!!!!
quand on regarde le code rgb des couleur de la palette il y en a certaine qui ne devrait pas fonctionner et POURTANT SI!!!!!
j'en conclu donc que dans l'application il doit y avoir des concordance prédéterminées
ca pour moi c'est un gros bug logique car en toute logique le code devrait donner des faux résultats

de la même manière que le code de PMO avec des valeurs dépassant des fois 255 devrait planter et bien non!! ca fonctionne
par contre avec le code de PMO je peut traiter la couleur sous toutes ses formes(long,rgb,hex)

voila si ca c'est pas des bugs logiques je deviens bonne sœur demain

[joe.levrai]

je me suis amusé à bidouiller le dernier code de gnain, si ça peut apporter du mieux

je regarderai peut être pour des gadgets en plus (progressivité, exclusion des plus foncés ou plus clair, patterns)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
Sub test()
Call Degrade(4, 20, True)
End Sub
 
 
Sub Degrade(Couleur As Long, Fraction As Long, ClairVersFonce As Boolean)
' Fraction = nombre de cellules
Dim Pas ' calcul le pas de la boucle
Dim Sens ' pour inverser le départ et la fin de la boucle
 
Couleur = (Couleur Mod 56)
If Couleur = 0 Then Couleur = 56
Couleur = ActiveWorkbook.Colors(Couleur)
Pas = -(1 / Fraction)
 
If Not ClairVersFonce Then
    Sens = 0.99
    Pas = Abs(Pas)
End If
 
    R = Couleur Mod 256
    G = (Couleur \ 256) Mod 256
    B = (Couleur \ 256 \ 256) Mod 256
 
k = 1
For i = 0.99 - Sens To 0 + Sens Step Pas
 
    If R <> 255 Then R = Abs(Round(255 * i))
    If G <> 255 Then G = Abs(Round(255 * i))
    If B <> 255 Then B = Abs(Round(255 * i))
 
    Couleur = RGB(R, G, B)
    Cells(k, 1).Interior.Color = Couleur
    k = k + 1
 
Next i
 
End Sub

on peut même ajouter un tableau de string avec l'argument Couleur : on aura Degrade(Bleu,20,True) par exemple

[gnain]

Bonjour Joe,
ton code n'est pas bon pour toute les couleurs. J'ai fait la même erreur dans les postes précédents.

Bonjour Patrick.


J'ai finalement pigé!
Cette fois ci c'est la bonne
Ce code fait toute les 56 ColorIndex

Si on enlève la boucle For j = 1 to 56 on peut mettre n'importe quel couleur en long ou RGB et ça fonctionne.

J'ai choisi 11 pour la variable Facteur_Degrade donc 11 en plus et 11 en moin
en changant la variable Facteur_Degrade pour un chiffre plus haut on obtient un dégradé plus doux

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
Sub C_est_la_Bonne()
 
For j = 1 To 56
    Couleur = ActiveWorkbook.Colors(j)
    'Couleur = RGB(255, 255, 2)
 
    R = Couleur Mod 256
    G = (Couleur \ 256) Mod 256
    B = (Couleur \ 256 \ 256) Mod 256
 
    k = 1
 
    Facteur_Degrade = 11
 
    Cells(1, 1).Interior.Color = RGB(255, 255, 255)
 
    If R <> 255 Then R_Bo = True
    If G <> 255 Then G_Bo = True
    If B <> 255 Then B_Bo = True
 
    R_C = Round((255 - R) / Facteur_Degrade)
    G_C = Round((255 - G) / Facteur_Degrade)
    B_C = Round((255 - B) / Facteur_Degrade)
 
    RR = 255
    GG = 255
    BB = 255
 
    For i = 1 To Facteur_Degrade
        If R_Bo = True Then RR = RR - R_C
        If G_Bo = True Then GG = GG - G_C
        If B_Bo = True Then BB = BB - B_C
        If RR < 0 Then RR = 0
        If GG < 0 Then GG = 0
        If BB < 0 Then BB = 0
        Cells(k, j).Interior.Color = RGB(RR, GG, BB)
        k = k + 1
    Next
 
    R_C = Round(R / Facteur_Degrade)
    G_C = Round(G / Facteur_Degrade)
    B_C = Round(B / Facteur_Degrade)
 
    For i = 1 To Facteur_Degrade
        RR = RR - R_C
        GG = GG - G_C
        BB = BB - B_C
 
        If RR < 0 Then RR = 0
        If GG < 0 Then GG = 0
        If BB < 0 Then BB = 0
 
        Cells(k, j).Interior.Color = RGB(RR, GG, BB)
        k = k + 1
    Next
Next
End Sub

[patricktoulon]

re
Bonjour gnain
non tu n'a rien pigé de l'essentiel en fait
je sais pas ou tu t'embarque quand tu code mais j'ai mal a la tête pour toi
en fait la chose est tres simple
ta couleur a trois variable
l'une d'entre elle est la plus petite
il faut ajouter la différence entre 255 et la valeur la plus petite a toutes
ensuite tu réduit les trois dans une boucle
jusqu'à que les 3 arrive a zero ,chacune a sa hauteur bien entendu pour garder la couleur

voila le mien d'exemple y a pas plus facile en une seul boucle
analyse bien ca

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
Sub couleur_TintAndShade_V_pat()
    Dim R%
    Dim G%
    Dim B%
    Const facteur = 10
    Couleur = ActiveWorkbook.Colors(3)
    R = Couleur Mod 256
    G = (Couleur \ 256) Mod 256
    B = (Couleur \ 256 \ 256) Mod 256
    RM = 255 - R: GM = 255 - G: BM = 255 - B
    maxi = WorksheetFunction.Max(RM, GM, BM)
    R% = R% + maxi: G% = G% + maxi: B% = B% + maxi
maxi = WorksheetFunction.Max(R, G, B)
    For i = 1 To Round(maxi / facteur)
        R = IIf(R > 0, R - facteur, 0)
        G = IIf(G > 0, G - facteur, 0)
        B = IIf(B > 0, B - facteur, 0)
        R = IIf(R < 0, 0, R)
        G = IIf(G < 0, 0, G)
        B = IIf(B < 0, 0, B)
        Cells(i, 1).Interior.Color = RGB(R, G, B)
        Cells(i, 2) = R & "," & G & "," & B
    Next
End Sub

on a bien bosser sur ce coup la
maintenant on va bosser avec 2 couleur en dégradé

[joe.levrai]

Zut, ça m'apprendra à tester uniquement les 8 premières couleurs
mais j'ai compris pourquoi ça marchait pas, c'est l'essentiel... et ça va trop alourdir le code de gérer les 6 cas différents

j'ai voulu économiser une boucle ... et je suis obligé d'en utiliser 4 avec ma méthode


Super ton code Patrick ,gnain je vais aussi tester le tiens

[gnain]

re
en fait la chose est tres simple
ta couleur a trois variable
l'une d'entre elle est la plus petite
il faut ajouter la différence entre 255 et la valeur la plus petite a toutes
ensuite tu réduit les trois dans une boucle
jusqu'à que les 3 arrive a zero ,chacune a sa hauteur bien entendu pour garder la couleur

C'est en plein ça que j'ai fait dans mon code Patrick! seulement qu'il n'était pas optimisé.
J'avais l'intention de l'optimisé aujourd'hui, mais tu ma devancé.
en fait on fait exactement la même chose.

la seule différance à part l'optimisation c'est que dans ton code le dégradé ne se fait pas sur le même nombre
de cellule pour toute les couleurs et le mien oui. mais cela est assez facile à réparer.
je te laisse le plaisir de le faire.

sinon +1 pour l'optimisation

test ton code avec une boucle de plus et tu verras.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
Sub couleur_TintAndShade_V_pat()
    Dim R%
    Dim G%
    Dim B%
    Const facteur = 10
For m = 1 To 56
    Couleur = ActiveWorkbook.Colors(m)
    R = Couleur Mod 256
    G = (Couleur \ 256) Mod 256
    B = (Couleur \ 256 \ 256) Mod 256
    RM = 255 - R: GM = 255 - G: BM = 255 - B
    maxi = WorksheetFunction.Max(RM, GM, BM)
    R% = R% + maxi: G% = G% + maxi: B% = B% + maxi
maxi = WorksheetFunction.Max(R, G, B)
    For i = 1 To Round(maxi / facteur)
        R = IIf(R > 0, R - facteur, 0)
        G = IIf(G > 0, G - facteur, 0)
        B = IIf(B > 0, B - facteur, 0)
        R = IIf(R < 0, 0, R)
        G = IIf(G < 0, 0, G)
        B = IIf(B < 0, 0, B)
        Cells(i, m).Interior.Color = RGB(R, G, B)
       ' Cells(i, 2) = R & "," & G & "," & B
    Next
Next
End Sub

[patricktoulon]

re

la seule différance à part l'optimisation c'est que dans ton code le dégradé ne se fait pas sur le même nombre
de cellule pour toute les couleurs et le mien oui. mais cela est assez facile à réparer.
je te laisse le plaisir de le faire.

ca n'a aucun intérêt
si tes dégradé on le même nombre de cellules c'est que le dégradé est incrémenté différemment

le mien c'est facteur qui décide du degré donc quand on arrive a zéro je vois pas pourquoi descendre plus bas entre nous
si je le veut plus long(progressif) j'augmente facteur voila tout et la on gère qu'une seule variable en l'occurrence "facteur"
tandis qu'avec le tien on aura des dégradés moins ordonnés (certains bon ,et certains avec des cellules trop différentes de la précédente
facteur c'est le pas chez moi il reste le même pour toutes les couleurs chez toi c'est le nombre de cellules
donc étant donné que l'on part avec des couleurs différentes il est normal que les dégradé soit différent selon la couleur ce qui n'est pas le cas chez moi

essaie un gros facteur du genre 100 par exemple tu verra le dégradé reste le même pour toute les couleurs

[gnain]

ca n'a aucun intérêt

J'avais cru comprendre que tu demandai les même dégradés que le TintAndShade incrémenté de .1 à la fois
quand tu nous à donné un exemple avec for i =0.1 to 0.7 step0.1

c'est ce que j'ai fait.
mais bon si ce n'était pas le but, je me suis creusé la méninge pour rien.

[patricktoulon]

l'essentiel pour moi est de partir de la couleur la plus claire
et puis entre temps on a évolué on a trouvé un moyen de déterminer un dégradé sans tintand shades ce qui était le sujet principal finalement

ensuite comme on a trouver une macro qui tourne bien on l'a fait évolué même si ca n'était pas l'intérêt du début

seul le résultat compte finalement non?
et puis sans moi vous vous ennuyez alors je m'occupe de faire travailler vos méninges

et résultat travaille en équipe participation de plusieurs personne et voila un truc nickel

bon il faut dire que c'est PMO qui remporte cette manche la prochaines se sera toi peut être ma dernière version est basé sur son principe
monter au max et descendre pas a pas

je prépare la même chose mais avec 2 couleur :mange du phosphore ca va faire Mal très mal!!!....

[gnain]

et puis sans moi vous vous ennuyez alors je m'occupe de faire travailler vos méninges

n'arrête surtout pas à sortir des questionnements trodus, mois dans mon cas c'est un challenge à chaque fois!!! et J'adore ça!!!

[patricktoulon]

hah!!!..... oui!!!
et ben tiens en voila une

parlons de dégradé de 2 couleurs
principe:
2 couleur différente s
récupération du rgb des 2

calcul de la difference entre r1 et r2 idem pour le G et B des deux couleurs
détermination du sens de décompte avec la fonction sgn(si c'est plus grand ou plus petit )

détermination de la valeur du pas pour chaque valeur(r g et b)
itération dans une boucle
application sur la cellule
j'ai fait une première approche mais elle ne fonctionne pas
la voici:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
Sub test8()
    Dim R1, R2, G1, G2, B1, B2
    Dim SR, SG, SB
    Dim couleur1, couleur2
    Fact = 50
    couleur1 = ActiveWorkbook.Colors(14)
    couleur2 = ActiveWorkbook.Colors(26)
    R1 = couleur1 Mod 256
    G1 = (couleur1 \ 256) Mod 256
    B1 = (couleur1 \ 256 \ 256) Mod 256
    R2 = couleur2 Mod 256
    G2 = (couleur2 \ 256) Mod 256
    B2 = (couleur2 \ 256 \ 256) Mod 256
    SR = Sgn(R1 - R2)
    SG = Sgn(G1 - G2)
    SB = Sgn(B1 - B2)
    factR = R1 - R2 / Fact
    factG = G1 - G2 / Fact
    factB = B1 - B2 / Fact
 
    Do
        i = i + 1
        R = R1 + (SR * factR) * i
        G = G1 + (SG * factG) * i
        B = B1 + (SB * factB) * i
 
        Cells(i, 1).Interior.Color = RGB(R, G, B)
    Loop Until i = Fact
 
 
End Sub

a tu a la tête dur et ben on va voir ca

[patricktoulon]

re
ne cherche plus j'ai trouvé

principe
on 2 couleurs
ces 2 couleurs on un rgb different

il faut déterminer quel est le R le plus grand des deux et pareil pour le G et le B pour connaitre le sens positif ou négatif de l'incrémentation dans la boucle pour R et G et B
ensuite on calcul la différence entre eux R1 et R2 et pareil pour G et B QUE L4ON DIVISERA PAS LA VARIABLE FACT qui nous sert de sep
la boucle c'est un do loop qui s'arête des que i= fact
ainsi en changeant seulement la valeur de fact on a un dégradé plus progressif ou l'inverse

tu verra c'est tout simple en fait

purée j'ai moins souffert pour celle la que le dégradé clair foncé

essaie ca

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
Sub test9()
 
    Dim R1, R2, G1, G2, B1, B2
    Dim SR, SG, SB
    Dim couleur1, couleur2
    Fact = 30
    couleur1 = RGB(133, 200, 0)
    couleur2 = RGB(200, 86, 0)
    R1 = couleur1 Mod 256
    G1 = (couleur1 \ 256) Mod 256
    B1 = (couleur1 \ 256 \ 256) Mod 256
    R2 = couleur2 Mod 256
    G2 = (couleur2 \ 256) Mod 256
    B2 = (couleur2 \ 256 \ 256) Mod 256
    'on determine le sens (positif ou negatif pour rejoindre r1 a r2: g1 a g2:   b1 a b2)
    SgnR = IIf(R1 < R2, 1, -1)
    SgnB = IIf(B1 < B2, 1, -1)
    SgnG = IIf(G1 < G2, 1, -1)
    'on determine le pas fact(r,g,b)
    factR = IIf(R1 < R2, (R2 - R1) / Fact, (R1 - R2) / Fact)
    factG = IIf(G1 < G2, (G2 - G1) / Fact, (G1 - G2) / Fact)
    factB = IIf(B1 < B2, (B2 - B1) / Fact, (B1 - B2) / Fact)
    Do
        i = i + 1
        ' on applique factR dans le sens que l'on a déterminé plus haut
        R = R1 + (SgnR * factR) * i
        B = B1 + (SgnB * factB) * i
        G = G1 + (SgnG * factG) * i
        Cells(i, 1).Interior.Color = RGB(R, G, B)
    Loop Until i = Fact
End Sub

[patricktoulon]

re
salut a tous
voila une version quasi définitive du dégradé bicolore , j'en ai fait une fonction ou l'on peut préciser le pourcentage de dégradé la couleur 1 et 2
plus le pourcentage est grand plus le nombre de dégradé est Grand a auteur de 255
si ca intéresse quelqu'un

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
Sub test_dégradé_bycolor()
    couleur1 = ThisWorkbook.Colors(5)
    couleur2 = ThisWorkbook.Colors(38)
    degradé_bi_color couleur1, couleur2, 20
End Sub
 
Function degradé_bi_color(couleur1, couleur2, pourcentage)
    Dim R1, R2, G1, G2, B1, B2, signR, sgnB, sgnG, R, G, B
    'fact représente le nombre de pas en fonction du pourcentage de dégradé demandé
    Fact = Round(255 / (100 / pourcentage))
    R1 = couleur1 Mod 256: R2 = couleur2 Mod 256
    G1 = (couleur1 \ 256) Mod 256: G2 = (couleur2 \ 256) Mod 256
    B1 = (couleur1 \ 256 \ 256) Mod 256: B2 = (couleur2 \ 256 \ 256) Mod 256
    'on détermine le sens (positif ou négatif pour rejoindre r1 a r2: g1 a g2:   b1 a b2)
    SgnR = IIf(R1 < R2, 1, -1): sgnB = IIf(B1 < B2, 1, -1): sgnG = IIf(G1 < G2, 1, -1)
    'on détermine le STEP  (positif ou négatif) factR,factG,factB
    factR = IIf(R1 < R2, (R2 - R1) / Fact, (R1 - R2) / Fact)
    factG = IIf(G1 < G2, (G2 - G1) / Fact, (G1 - G2) / Fact)
    factB = IIf(B1 < B2, (B2 - B1) / Fact, (B1 - B2) / Fact)
    Do
 
        ' on applique factR  et G et B dans le sens que l'on a déterminé plus haut
        R = R1 + (SgnR * factR) * i
        B = B1 + (sgnB * factB) * i
        G = G1 + (sgnG * factG) * i
' on évite l'erreur pour R ou G ou B en dessous de zéro
        R = IIf(R < 0, 0, R)
        G = IIf(G < 0, 0, G)
        B = IIf(B < 0, 0, B)
       i = i + 1
       Cells(i, 1).Interior.Color = RGB(R, G, B)
    Loop Until R = R2 And G = G2 And B = B2
End Function