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
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
mes fichiers dans les contributions:
mail avec CDO en vba et mail avec CDO en vbs dans un HTA
survol des bouton dans userform
prendre un cliché d'un range
si ton problème est résolu n'oublie pas de pointer : : ça peut servir aux autres
et n'oublie pas de voter
TintAndShade ?
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
donc choux blanc pour 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
mes fichiers dans les contributions:
mail avec CDO en vba et mail avec CDO en vbs dans un HTA
survol des bouton dans userform
prendre un cliché d'un range
si ton problème est résolu n'oublie pas de pointer : : ça peut servir aux autres
et n'oublie pas de voter
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
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
mes fichiers dans les contributions:
mail avec CDO en vba et mail avec CDO en vbs dans un HTA
survol des bouton dans userform
prendre un cliché d'un range
si ton problème est résolu n'oublie pas de pointer : : ça peut servir aux autres
et n'oublie pas de voter
tu veux aller de 0.5 à "exactement" 1 en 7 jours ?maintenant je voudrais démarrer a la moitié soit 0.5 sur 7 jours il m'en maque 2
la précision est au Single, c'est déjà pas mal
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
pour le reste, c'est du grand Patrick
c'est pour ta commandbars ?
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
ainsi on a 7 dégradé mais plus clair
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
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
mes fichiers dans les contributions:
mail avec CDO en vba et mail avec CDO en vbs dans un HTA
survol des bouton dans userform
prendre un cliché d'un range
si ton problème est résolu n'oublie pas de pointer : : ça peut servir aux autres
et n'oublie pas de voter
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!!!!
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
bon finalement elle ne nous a pas donner trop de fils a retordre 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
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
re
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
apres different test je me retrouve toujour un peu perplexe
voila une autre version assez intrigante
testez celle la
ce qui m'intrigue c'est qu'avec la méthode tintandshade on travaille avec une couleur rose (65537)
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
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
mes fichiers dans les contributions:
mail avec CDO en vba et mail avec CDO en vbs dans un HTA
survol des bouton dans userform
prendre un cliché d'un range
si ton problème est résolu n'oublie pas de pointer : : ça peut servir aux autres
et n'oublie pas de voter
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 ?
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
mes fichiers dans les contributions:
mail avec CDO en vba et mail avec CDO en vbs dans un HTA
survol des bouton dans userform
prendre un cliché d'un range
si ton problème est résolu n'oublie pas de pointer : : ça peut servir aux autres
et n'oublie pas de voter
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 ?
Bonjour,
pour de beau dégradé sans passer par un objet
pour calculer le RGB
ex: pour colorindex 6
donc si on veut le long de la couleur ActiveWorkbook.Colors(6) avec un TintAndShade = 0.5 son long est 8454143
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 & ")"
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
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
puré gnain je te met la paté !!!!
dans un de tes post precedent tu me dit de faire
et ensuite tu dis le contraire
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
ca te vaut un RGB(-1,-1,-1)
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)
mes fichiers dans les contributions:
mail avec CDO en vba et mail avec CDO en vbs dans un HTA
survol des bouton dans userform
prendre un cliché d'un range
si ton problème est résolu n'oublie pas de pointer : : ça peut servir aux autres
et n'oublie pas de voter
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!!
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
la vous m'avez rendu fou
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
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
la je deviens fou c'est quoi ce truc ????
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
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
mes fichiers dans les contributions:
mail avec CDO en vba et mail avec CDO en vbs dans un HTA
survol des bouton dans userform
prendre un cliché d'un range
si ton problème est résolu n'oublie pas de pointer : : ça peut servir aux autres
et n'oublie pas de voter
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
bon le fait est que nous arrivons a partir de la couleur vers le plus foncé(noir) avec ceci:
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
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
je voudrais réunir les deux dans une même fonction et dans une même boucle
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
mes fichiers dans les contributions:
mail avec CDO en vba et mail avec CDO en vbs dans un HTA
survol des bouton dans userform
prendre un cliché d'un range
si ton problème est résolu n'oublie pas de pointer : : ça peut servir aux autres
et n'oublie pas de voter
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
Vous avez un bloqueur de publicités installé.
Le Club Developpez.com n'affiche que des publicités IT, discrètes et non intrusives.
Afin que nous puissions continuer à vous fournir gratuitement du contenu de qualité, merci de nous soutenir en désactivant votre bloqueur de publicités sur Developpez.com.
Partager