Discussion :

[patricktoulon]

bonjour a tous
je souhaiterais dans un tableau contenant un calendrier faire un dégradé d'une couleur avec 7 variations du plus clair au plus foncé ( lundi au dimanche )

quelqu'un aurais une idée , pitié pas polychromie

[joe.levrai]

TintAndShade ?

[patricktoulon]

salut joe
tu pense bien qu'ai essayé avec l'enregistreur de macro aumoins ca quand meme avant de poster
voila ce que me donne l'enregistreur de macro
comme tu peut le constater c'est la couleur qui change pas le 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
Sub Macro1()
'
' Macro1 Macro
'
'
    Range("B2").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 14336204
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 12159391
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
End Sub

donc choux blanc pour tintandshade

[joe.levrai]

tu as mal essayé ?

je te laisse jouer sur .Color et sur la sensibilité du dégradé "i" (entre -1 et 1)

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub Degrade()
Dim i As Single
Dim j As Long
j = 1
For i = 0.4 To 1 Step 0.1
 
    With Cells(2, j).Interior
        .Color = 65537
        .TintAndShade = i
    End With
    j = j + 1
Next i
 
End Sub

[patricktoulon]

re
la autant pour moi c'est toi qui me met la patée

1 étant la valeur la plus claire

allez maintenant tu t'en doute bien c'est le moment ou viens la question tordue

maintenant je voudrais démarrer a la moitié soit 0.5 sur 7 jours il m'en maque 2

alors comment fait on pour récupérer le code long ou hex de la couleur obtenue sans passer par un Object

et oui c'est jamais simple avec Patrick

hein!!! pouvé récapeter la question????

en gros ma couleur de depart c'est couleur .tintandshade 0.5

[joe.levrai]

maintenant je voudrais démarrer a la moitié soit 0.5 sur 7 jours il m'en maque 2

tu veux aller de 0.5 à "exactement" 1 en 7 jours ?

Code :

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

1
2
3
4
5
6
7
For i = 0.5 To 1 Step (0.5 / 7)
    With Cells(2, j).Interior
        .Color = 65537
        .TintAndShade = i
    End With
    j = j + 1
Next i

la précision est au Single, c'est déjà pas mal

pour le reste, c'est du grand Patrick
c'est pour ta commandbars ?

[patricktoulon]

re

non c'est pour la cmb

apres ton idée de diviser le sgment n'est tout a fait ce que je cherche

en fait pour avoir un dégradé plus clair il faudrait que je demarre du long corespondant a couleur.tintshade 0.5 pour incrémenté une boucle de 7

sinon c'est trop foncé au départ
donc mon idée serait de faire

Code :

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

1
2
3
4
5
6
7
cells1,1).interior.color=couleur
cells(1,1).tintandshade 0.5
couleur=cells(1,1).interior.color
for i =0.1 to 0.7 step0.1
cells(i*10,1.interior.color=couleur
cells(i*10,1).tintshade i
next

ainsi on a 7 dégradé mais plus clair
mais le soucis comme je suis un peu tordu je voudrais faire la même chose sans me servir de cells(1,1) ca serait plus rigolo

[gnain]

Bonjour Patrick,
TintAndShade de -1 à 0 c'est assez facile à calculer

TintAndShade = -1 est toujours 0
TintAndShade = -0.9 : -0.9 veux dire 90% plus foncé donc pour obtenir le long,
la formule est multiplier (couleur en long) par le (pourcentage restant)
ex: si couleur = 255 et TintAndShade = -0.9 alors il reste 10 %, si on calcul 255 x 0.10 = 25.5, on arrondi et le long est 26


ex: couleur 255
TintAndShade = -0.9 : 255 x 0.10 = 25.5 arrondi = 26
TintAndShade = -0.8 : 255 x 0.20 = 51
TintAndShade = -0.7 : 255 x 0.30 = 76.5 arrondi = 77
TintAndShade = -0.6 : 255 x 0.40 = 102
TintAndShade = -0.5 : 255 x 0.50 = 127.5 arrondi = 128
TintAndShade = -0.4 : 255 x 0.60 = 153
TintAndShade = -0.3 : 255 x 0.70 = 178.5 arrondi = 179
TintAndShade = -0.2 : 255 x 0.80 = 204
TintAndShade = -0.1 : 255 x 0.90 = 229.5 arrondi = 230

cela fonctionne avec toute les couleurs

mais pour les positifs, de 0 à 1, ho la la, je pense que le gars chez Microsoft a bu un verre de trop
pour calculer le long d'une couleur avec un TintAndShade positif.
J'ai déjà essayé de comprendre dans le passé, mais peine perdu, je n'ai jamais trouvé.

Pourtant il était simple que de suivre la même logique que les négatifs, mais non...., C'est du Microsoft!!!!

[patricktoulon]

bonjour joe et gnain

je pense avoir trouvé et compris comment ca fonctionne

avec la methode de gnain
en fait on arait tendance a ce cantonner a vouloir multiplier la couleur avec un chiffre positif ou négatif

j'ai donc proceder autrement
plutôt que de chercher le positif ou negatif j'ai diviser le diviseur en l'ocurence (0.1) par 10 ce qui donne 0.01

ce qui nous permet d' obtenir un dégradé de 100 incrémentations
ensuite par curiosité je suis monter a 2 donc 200 incrémentations ca fonction

ensuite parceque je suis un peu dingue je suis aller jusqu'à 3
et la on constate que c'est la couleur qui change vers la fin (257)

donc j'en conclu que le negatif et le positif se trouve dans le entier
soit 0.1 a 0.5 =negatif et 0.5 a 1 =positif
puisque dans les 200 j'obtiens le blanc et la couleur entière
tester celle la

Code :

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

1
2
3
4
5
6
7
8
9
10
Sub test()
couleur = 65537
For i = 0.01 To 3 Step 0.01
e = i * 100
percents = 1 - i * 100
Debug.Print percents
Cells(e, 1).Interior.Color = couleur * Round(percents)
Cells(e, 2) = couleur * percents
Next
End Sub

bon finalement elle ne nous a pas donner trop de fils a retordre celle la

je vous aurais un jour!!!!!

j'en trouverais une qui plantera tout le monde

c'est encore Gnain qui m'a mis sur la voie
essayez 2 et puis essayer 3 vous verrez!

il me viens une question
et la on est vraiment dans le tordu
pourquoi quand j'utilise la même méthode mais avec tintandshade je n'ai pas la même couleur
pourtant je démarre avec la même

Code :

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

1
2
3
4
5
6
7
8
9
10
Sub test2()
For i = 0.01 To 1 Step 0.01
    e = e + 1
    With Cells(e, 6).Interior
        .Color = 65537
        .TintAndShade = i
    End With
 
Next i
End Sub

re
apres different test je me retrouve toujour un peu perplexe

voila une autre version assez intrigante
testez celle la

Code :

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

1
2
3
4
5
6
7
8
9
Sub test3()
Do
   e = e + 1
 couleur = 65537 - 1024 * e
   Cells(e, 6).Interior .Color = couleur
  Cells(e, 7) = Cells(e, 6).Interior.Color
If e > 1 Then Cells(e, 8) = Cells(e, 7) - Cells(e - 1, 7)
Loop Until couleur = 1 'si on va plus loin on change de couleur
End Sub

ce qui m'intrigue c'est qu'avec la méthode tintandshade on travaille avec une couleur rose (65537)
et la méthode couleur travaille avec une couleur verte avec le même long(65537)
aurais je trouvé encore un bug logique dans office
ou tintandshades ne ferait pas que multiplier ? telle est la question

[joe.levrai]

hier soir j'ai fais un message long comme un jour sans pain, en décrivant justement le phénomène du "chaque Long peut afficher la couleur d'un autre Long grâce à TintAndShade


pour tout Color X, dont leTintAndShade est non nul, il existe un Color Y dont le TintAndShade est nul

en gros, TintAndShade est à Color, ce que Offset est à Cells : il permet de se déplacer sur la palette

j'avais aussi foutu un exemple un peu comme les tiens

mais j'ai supprimé le message , car ça me paraissait trop évident pour que tu ne t'en rende pas compte tout seul

On peut pas récupérer un message qu'on a supprimé du forum ?

[patricktoulon]

bonjour joe
j'avais remarqué cette analogie mais mon soucis n'est pas la

c'est en fait l'amalgame entre la couleur et le diviseur (méthode gain) qui ne donne pas la même couleur avec ta méthode(tintandshade)
qui donne la clarté de la couleur

mes précédents exemples le démontrent

ca m'a permis quand même de trouver le moyen de faire des beau dégradé de couleur

[joe.levrai]

Si ta couleur "saute" à 257, on doit remonter dans la gestion des couleurs RGB et le fameux Mod 256

admettons que ton color est 10000 (en Long), ton RGB est

R = Int(10000 Mod 256)
G = Int(10000 Mod 65536) / 256)
B = Int(10000 / 65536)

je pense donc qu'on saute de couleur à chaque palier 256 ?

[gnain]

Bonjour,
pour de beau dégradé sans passer par un objet

pour calculer le RGB
ex: pour colorindex 6

Code :

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

1
2
3
4
5
6
7
8
9
 Dim R As Long
Dim G As Long
Dim B As Long
 
couleur = ActiveWorkbook.Colors(6)
R = couleur Mod 256
G = (couleur \ 256) Mod 256
B = (couleur \ 256 \ 256) Mod 256
MsgBox "RGB(" & R & ", " & G & ", " & B & ")"

donc si on veut le long de la couleur ActiveWorkbook.Colors(6) avec un TintAndShade = 0.5 son long est 8454143

alors on fait 255 x 0.5 = 128
donc le rgb est RGB(255 ,255, 128)

en verifiant
MsgBox RGB(255, 255, 128)
donne bien 8454143



un autre verification
si on veut le long de la couleur ActiveWorkbook.Colors(6) avec un TintAndShade = 0.8 son long est de 13434879
alors on fait 255 x 0.8 = 204
donc le rgb est RGB(255 ,255, 204)

en verifiant
MsgBox RGB(255, 255, 204)
donne bien 13434879

[joe.levrai]

Ouais, le trio de choc :

Patrick et ses questions tordues
Joe et ses théories tirées par les cheveux
gnain et ses tests/résolutions

[patricktoulon]

puré gnain je te met la paté !!!!

dans un de tes post precedent tu me dit de faire

Code :

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

1
2
3
4
5
6
7
Bonjour Patrick,
 TintAndShade de -1 à 0 c'est assez facile à calculer

 TintAndShade = -1 est toujours 0
 TintAndShade = -0.9 : -0.9 veux dire 90% plus foncé donc pour obtenir le long,
 la formule est multiplier (couleur en long) par le (pourcentage restant)
 ex: si couleur = 255 et TintAndShade = -0.9 alors il reste 10 %, si on calcul 255 x 0.10 = 25.5, on arrondi et le long est 26

et ensuite tu dis le contraire

Code :

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

1
2
3
4
un autre verification
 si on veut le long de la couleur ActiveWorkbook.Colors(6) avec un TintAndShade = 0.8 son long est de 13434879
 alors on fait 255 x 0.8 = 204
 donc le rgb est RGB(255 ,255, 204)

ca te vaut un RGB(-1,-1,-1)

[gnain]

Bonjour Patrick,
je ne dit pas le contraire, c'est seulement 2 méthode différentes.

C'est seulement des constatations.

dans l'autre poste je ne passait pas par les couleur RGB c'était un calcul direct avec pourcentage
et cela fonctionne seulement pour les négatif de -1 à 0.
malheureusement ça ne fonctionne pas pour les positif de 0 à 1


maintenant mon 2e poste montre une possibilité pour les positif de 0 à 1 en passant par les couleur RGB
donc si on veut le long de la couleur ActiveWorkbook.Colors(6) avec un TintAndShade = 0.5 son long est 8454143

alors on fait 255 x 0.5 = 128
donc le rgb est RGB(255 ,255, 128)

en verifiant
MsgBox RGB(255, 255, 128)
donne bien 8454143

essaie ce test....

cette 2e méthode ne fonctionne pas pour les négatifs.

Compliqué chez Microsoft!!

[patricktoulon]

re

gnain apres test ca ne marche pas ton truc

et en plus on a pas la meme palette la couleur 6 me donne pas le même long

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub test4()
Dim Rouge As Integer, Vert As Integer, Bleu As Integer
    Dim Couleur As Long
Couleur = ActiveWorkbook.Colors(12)
Rouge = Int(Couleur Mod 256)
    Vert = Int((Couleur Mod 65536) / 256)
    Bleu = Int(Couleur / 65536)
For i = 0.1 To 1 Step 0.1
 Bleu = Bleu * i
Cells(i * 10, 10).Interior.Color = RGB(Rouge, Vert, Bleu)
Cells(i * 10, 11) = Cells(i * 10, 10).Interior.Color
 
Next
End Sub

la vous m'avez rendu fou
on s'éloigne de plus en plus

pour faire court l'exemple dans mes precedent message agissant sur la couleur et non le tinandshade donnait un dégradé du negatif de la couleur puisque l'on va de la couleur vers le noir

l'exemple avec le tintandshade donnait les deux puisque l'on va jusqu'au blanc

j'aimerais trouver le calcul qui fasse les deux sur une couleur

et pour vous prouver que je ne poste pas de question pour rien
voila un exemple flagrant de bug logique mais énorme
voila un exemple adapter de la methode gnain
débloquez la ligne verte et bloquez celle avec le comentaire
et vis et versa vous comprendrez tout de suite

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
Sub test3()
Dim couleur As Long
couleur = 65537
Do
   e = e + 1
'couleur = 65537 - 1024 * e
couleur = couleur - 1024 * e ' bloquez celle ci si celle du dessus est débloquée 
   Cells(e, 6).Interior.Color = couleur
  Cells(e, 7) = Cells(e, 6).Interior.Color
If e > 1 Then Cells(e, 8) = Cells(e, 7) - Cells(e - 1, 7)
Loop Until couleur = 1  'si on va plus loin on change de couleur
End Sub

la je deviens fou c'est quoi ce truc ????

Edit : oupss!!! c'est moi qui est bugué en fait
couleur change forcement
je suis un cretin il faut supprimer le multiplicateur - 1024 tout simplement avec la variable couleur et * i avec le long en dur

je suis un cretinx

[joe.levrai]

je trouve des fils conducteurs, mais j'ai pas encore réussi à trouver le fil qui permet de tout comprendre

met en I2 : =H2-H1

etire jusqu'en bas ... et admire le joli pattern qu'il faut analyser et qui semble lié à la valeur maximale d'un chiffre codé en X bits

[patricktoulon]

bon le fait est que nous arrivons a partir de la couleur vers le plus foncé(noir) avec ceci:

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
Sub test3()
Dim couleur As Long
couleur = 65537
Do
   e = e + 1
'couleur = 65537 - 1024 * e
couleur = couleur - 1024
   Cells(e, 6).Interior.Color = couleur
  Cells(e, 7) = Cells(e, 6).Interior.Color
If e > 1 Then Cells(e, 8) = Cells(e, 7) - Cells(e - 1, 7)
Loop Until e = couleur = 1 'si on va plus loin on change de couleur
End Sub

et que nous arrivons a partir de la couleur vers le blanc avec ceci:

Code :

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

1
2
3
4
5
6
7
8
9
10
11
Sub test()
couleur = 65537
For i = 0.1 To 2.6 Step 0.1
e = e + 1
percents = 1 - i * 100
Debug.Print percents
Cells(e, 1).Interior.Color = Round(couleur * percents)
Cells(e, 2) = couleur * percents
Cells(e, 3) = (percents - percents * 2) / 2 & "%"
Next
End Sub

je voudrais réunir les deux dans une même fonction et dans une même boucle

[PMO2017]

Bonjour,

Une autre approche avec le code suivant

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
Sub aa()
Const FACTEUR_FONCE As Integer = 16
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)
 
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