Discussion :

[patricktoulon]

bonsoir a tous

je travaille en ce moment sur un truc un peu inutile comme a mon habitude mais bon ça me plaît


je voudrais :

parti d'un nombre de couleur

exemple
jaune,rouge,vert,orange,bleu

avec un algorithme bien ficelé

écrire dans une cellule par exemple "développez"

divise ce mot par le nombre de couleur disponible

donc "d" en jaune "e" en dégradé jaune/rouge etc....

sachant que je met le texte en couleur par la formule "RGB" exemple rouge "Rgb((255,0,0)"
je sais pas si vous m'avez compris

je tente quand même

merci pour le retour

[fring]

Salut Patrick,

Cela devrait ressembler à un truc de ce style

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 degcoul()
Dim R1 As Integer, V1 As Integer, B1 As Integer
Dim R2 As Integer, V2 As Integer, B2 As Integer
Dim difR As Integer, difV As Integer, difB As Integer
Dim nbVal As Integer
 
'couleur 1 : RGB(R1, V1, B1)
R1 = 150
V1 = 150
B1 = 0
'couleur 2 : RGB(R2, V2, B2)
R2 = 250
V2 = 250
B2 = 0
 
'définition du nombre de teintes à obtenir entre la couleur 1 et 2
nbVal = Len(Cells(1, 1)) '<-- la cellule A1 contient le mot "developpez" par exemple
 
'calcul du différentiel entre chaque teinte pour chaque canal de couleur
difR = Int((R2 - R1) / nbVal)
difV = Int((V2 - V1) / nbVal)
difB = Int((B2 - B1) / nbVal)
 
'coloration de chaque lettre du mot contenu en A1
For i = 1 To nbVal
    Cells(1, 1).Characters(Start:=i, Length:=1).Font.Color = RGB(R1, V1, B1)
    R1 = R1 + difR
    V1 = V1 + difV
    B1 = B1 + difB
Next
 
End Sub

Ce qui donne comme résultat :

[patricktoulon]

bonjour fring

joile code il me plaît bien

mais il ne fonctionne que pour 2 couleurs

et pour cela j'avais fait plus simple

exemple :

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
 
sub degradévertbleu()
with cells(1,1)
divs = 255 / Len(.value)
r = 255
b = 0
For i = 1 To Len(.value)
      With .Characters(Start:=i, Length:=1).Font
        r = r - divs + 1
        b = b + divs - 1
        .Color = RGB(0, r, b)
           End With
 Next
end with 
end sub

c'est sur plus de deux couleur que je colle

merci pour le coup de main

quand je regarde ton code et le mien on vois la différence entre un autodidacte comme moi et quelqu'un qui a appris a coder dans les règle de l'art

le code est plus jolie

je pense qu'il faut jouer sur la variable obtenue sur le len(cells(1,1).value

ensuite diviser ce len par le nombre de couleur

et a partir de la fring va nous concocter un code du tonnerre


merci pour le retour

[patricktoulon]

re

déjà pour cela il faudrait que je puissent ramener un nombre négatif a un nombre positif
en effet parfois une des trois couleur primaire de la couleur suivant l'autre peut être inférieur ou supérieur

ton opération avec le nval n'est pas une mauvaise idée il faudrais le diviser par le nombre de couleur demandées




et faire l'opération le mémé nombre de fois que de couleur de couleur mais pour cela il faut déjà utiliser des nombre positif
ou la je me perd enfin je crois que tu m'a compris

EDIT:2 heure plus tard je patoge encore
j'ai essayé ceci: mais ca n'est pas concluant pourtant je devrais terminé avec la derniere lettre en bleu

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
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
 
 
Sub degcoul()
    Dim R1 As Integer, V1 As Integer, B1 As Integer
    Dim R2 As Integer, V2 As Integer, B2 As Integer
    Dim difR As Integer, difV As Integer, difB As Integer
    Dim nbVal As Integer
    Dim longeur As Long
 
    'couleur 1 : RGB(R1, V1, B1)
    R1 = 150
    V1 = 150
    B1 = 0
    'couleur 2 : RGB(R2, V2, B2)
    R2 = 250
    V2 = 250
    B2 = 0
 
    'couleur 3 : RGB(R3, V3, B3)
    R3 = 10
    V3 = 20
    B3 = 180
 
 
    'couleur 4 : RGB(R4, V4, B4)
    R4 = 0
    V4 = 0
    B4 = 255
 
    'définition du nombre de teintes à obtenir entre la couleur 1 et 2 ET 3 ET 4
    longeur = Int(Len(Cells(1, 1)) / 4)  'ON DIVISE LE TEXTE PAR LE NOMBRE DE COULEUR
 
    nbVal = Int(Len(Cells(1, 1)))  '<-- la cellule A1 contient le mot "developpez" par exemple
 
    'calcul du différentiel entre chaque teinte pour chaque canal de couleur
 
    'coloration de chaque lettre du mot contenu en A1
    For i = 1 To nbVal
        If i <= longeur * 1 Then
 
            difR = IIf(Int((R1 - R2) / longeur) < 0, Int((R1 - R2) / longeur) - Int((R1 - R2) / longeur) * 2, Int((R1 - R2) / longeur))
            difV = IIf(Int((V1 - V2) / longeur) < 0, Int((V1 - V2) / longeur) - Int((V1 - V2) / longeur) * 2, Int((V1 - V2) / longeur))  ' C'EST DANS CETTE OPERATION QU'IL FAUDRAIT ELIMINER L'ORDRE DE SOUSTRACTION car il faut que ca soit automatique
            difB = IIf(Int((B1 - B2) / longeur) < 0, Int((B1 - B2) / longeur) - Int((B1 - B2) / longeur) * 2, Int((B1 - B2) / longeur))
           'ca m'ennuyait de devoir refaire la macro a chaque fois que je changeais de couleur  donc dif R,V,B EST MAINTENANT POSITIF A CHAQUE FOIS
            R1 = R1 + difR
            V1 = V1 + difV
            B1 = B1 + difB
            Cells(1, 1).Characters(Start:=i, Length:=1).Font.Color = RGB(R1, V1, B1)
        ElseIf i > longeur * 1 And i <= longeur * 2 Then
            difR = IIf(Int((R2 - R3) / longeur) < 0, Int((R2 - R3) / longeur) - Int((R2 - R3) / longeur) * 2, Int((R2 - R3) / longeur))
            difV = IIf(Int((V2 - V3) / longeur) < 0, Int((V2 - V3) / longeur) - Int((V2 - V3) / longeur) * 2, Int((V2 - V3) / longeur))  ' C'EST DANS CETTE OPERATION QU'IL FAUDRAIT ELIMINER L'ORDRE DE SOUSTRACTION car il faut que ca soit automatique
            difB = IIf(Int((B2 - B3) / longeur) < 0, Int((B2 - B3) / longeur) - Int((B2 - B3) / longeur) * 2, Int((B2 - B3) / longeur))
            R1 = R1 + difR
            V1 = V1 + difV
            B1 = B1 + difB
            Cells(1, 1).Characters(Start:=i, Length:=1).Font.Color = RGB(R1, V1, B1)
 
        ElseIf i > longeur * 2 And i <= longeur * 3 Then
            difR = IIf(Int((R3 - R4) / longeur) < 0, Int((R3 - R4) / longeur) - Int((R3 - R4) / longeur) * 2, Int((R3 - R4) / longeur))
            difV = IIf(Int((V3 - V4) / longeur) < 0, Int((V3 - V4) / longeur) - Int((V3 - V4) / longeur) * 2, Int((V3 - V4) / longeur))  ' C'EST DANS CETTE OPERATION QU'IL FAUDRAIT ELIMINER L'ORDRE DE SOUSTRACTION car il faut que ca soit automatique
            difB = IIf(Int((B3 - B4) / longeur) < 0, Int((B4 - B4) / longeur) - Int((B3 - B4) / longeur) * 2, Int((B3 - B4) / longeur))
            R1 = R1 + difR
            V1 = V1 + difV
            B1 = B1 + difB
            Cells(1, 1).Characters(Start:=i, Length:=1).Font.Color = RGB(R1, V1, B1)
 
 
        End If
 
 
 
 
    Next
 
End Sub

mais ca ne fonctionne pas

merci pour le retour

au plaisir

[patricktoulon]

re

yes youpi trop fort

voila j'ai repris ton idée dans l'ensemble

j'ai éliminé le besoins d'avoir des nombres positifs

maintenant le degradé se fait par le nombre de couleur

principe:
on divise le texte par le nombre de couleur
on obtiens un diviseur au quel on eleve 1
ce chiffre va nou servir en entrer et sortir des if et elseif dans la boucle

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
58
59
60
61
62
63
64
 
Sub degcoul()
    Dim R1 As Integer, V1 As Integer, B1 As Integer
    Dim R2 As Integer, V2 As Integer, B2 As Integer
    Dim difR As Integer, difV As Integer, difB As Integer
    Dim nbVal As Integer
    Dim longeur As Long
    'couleur 1 : RGB(R1, V1, B1)
    R1 = 255
    V1 = 0
    B1 = 0
    'couleur 2 : RGB(R2, V2, B2)
    R2 = 0
    V2 = 0
    B2 = 255
    'couleur 3 : RGB(R3, V3, B3)
    R3 = 0
    V3 = 255
    B3 = 0
    'couleur 4 : RGB(R4, V4, B4)
    R4 = 0
    V4 = 255
    B4 = 255
    'définition du nombre de teintes à obtenir entre la couleur 1 et 2 ET 3 ET 4
    longeur = Int(Len(Cells(1, 1)) / 3)  'ON DIVISE LE TEXTE PAR LE NOMBRE DE COULEUR
    nbVal = Int(Len(Cells(1, 1)))  '<-- la cellule A1 contient le mot "developpez" par exemple
    'calcul du différentiel entre chaque teinte pour chaque canal de couleur
    'coloration de chaque lettre du mot contenu en A1
    For i = 1 To nbVal
        If i <= longeur * 1 Then
            difR = Int((R1 - R2) / longeur)
            difV = Int((V1 - V2) / longeur)
            difB = Int((B1 - B2) / longeur)
            'ca m'ennuyait de devoir refaire la macro a chaque fois que je changeais de couleur  donc dif R,V,B EST MAINTENANT POSITIF A CHAQUE FOIS
 
            R1 = R1 + -difR
            V1 = V1 + -difV
            B1 = B1 + -difB
            Cells(1, 1).Characters(Start:=i, Length:=1).Font.Color = RGB(R1, V1, B1)
 
        ElseIf i >= longeur * 1 And i <= longeur * 2 Then
            difR = Int((R1 - R3) / longeur)
            difV = Int((V1 - V3) / longeur)
            difB = Int((B1 - B3) / longeur)
            'ca m'ennuyait de devoir refaire la macro a chaque fois que je changeais de couleur  donc dif R,V,B EST MAINTENANT POSITIF A CHAQUE FOIS
            R1 = R1 + -difR
            V1 = V1 + -difV
            B1 = B1 + -difB
            Cells(1, 1).Characters(Start:=i, Length:=1).Font.Color = RGB(R1, V1, B1)
 
        ElseIf i >= longeur * 2 And i Then
            difR = Int((R1 - R4) / longeur)
            difV = Int((V1 - V4) / longeur)
            difB = Int((B1 - B4) / longeur)
            'ca m'ennuyait de devoir refaire la macro a chaque fois que je changeais de couleur  donc dif R,V,B EST MAINTENANT POSITIF A CHAQUE FOIS
 
            R1 = R1 + -difR
            V1 = V1 + -difV
            B1 = B1 + -difB
            Cells(1, 1).Characters(Start:=i, Length:=1).Font.Color = RGB(R1, V1, B1)
        End If
    Next
 
End Sub

reste a maintenant l'ecrire avec un style plus classe

steuplé!...fring

au plaisir

[patricktoulon]

re fring

en attendant c'est maintenant une fonction

on a la possibilité de metre jusqu'a 7 couleur en argument
les argument couleur sont en type variant donc on peut injecté l'argument couleur des 3 manieres (long,hex,vb)comme le montre cet exemple
voila comment on l'appelle

Code :

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

1
2
3
4
5
 
Sub test_texte()
    texte_en_degradé "un texte en degradé dans ma cellule ", "algerian", vbRed, vbYellow, &HFF00FF, vbBlue, 1545698
 
End Sub

et voila le code de la fonction

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
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
 
Function texte_en_degradé(texte As String, Optional sfontname As Variant = "Calibri", Optional couleur1 As Variant = 0, Optional couleur2 As Variant = 0, Optional couleur3 As Variant = 0, Optional couleur4 As Variant = 0, Optional couleur5 As Variant = 0, Optional couleur6 As Variant = 0, Optional couleur7 As Variant = 0)
 Dim nbVal As Integer, R1 As Integer, V1 As Integer, B1 As Integer, R2 As Integer, V2 As Integer, B2 As Integer, difR As Integer, difV As Integer, difB As Integer
 Dim longeur As Long, nbcolor As Long
 
    Cells(1, 1) = texte
    Cells(1, 1).Font.Name = sfontname
 
    '"""""""""""""""""""""""""""""""""""""""""
    '  methode all to RGB                    "
    ' Rouge = Int(Couleur Mod 256)           "
    ' Vert = Int((Couleur Mod 65536) / 256)  "
    'Bleu = Int(Couleur / 65536)             "
    '"""""""""""""""""""""""""""""""""""""""""
    'couleur 1 : RGB(R1, V1, B1)
    R1 = Int(couleur1 Mod 256)
    V1 = Int((couleur1 Mod 65536) / 256)
    B1 = Int(couleur1 / 65536)
    nbcolor = 1
    '""""""""""""""""""""""""""""""""""""""""""""""
    'couleur 2 : RGB(R2, V2, B2)
    R2 = Int(couleur2 Mod 256)
    V2 = Int((couleur2 Mod 65536) / 256)
    B2 = Int(couleur2 / 65536)
    If couleur2 <> 0 Then nbcolor = nbcolor + 1
    '""""""""""""""""""""""""""""""""""""""""""""""
    'couleur 3 : RGB(R3, V3, B3)
    R3 = Int(couleur3 Mod 256)
    V3 = Int((couleur3 Mod 65536) / 256)
    B3 = Int(couleur3 / 65536)
    If couleur3 <> 0 Then nbcolor = nbcolor + 1
    '""""""""""""""""""""""""""""""""""""""""""""""
    'couleur 4 : RGB(R4, V4, B4)
    R4 = Int(couleur4 Mod 256)
    V4 = Int((couleur4 Mod 65536) / 256)
    B4 = Int(couleur4 / 65536)
    If couleur4 <> 0 Then nbcolor = nbcolor + 1
    '""""""""""""""""""""""""""""""""""""""""""""""
    'couleur 5 : RGB(R5, V5, B5)
    R5 = Int(couleur5 Mod 256)
    V5 = Int((couleur5 Mod 65536) / 256)
    B5 = Int(couleur5 / 65536)
    If couleur5 <> 0 Then nbcolor = nbcolor + 1
    '""""""""""""""""""""""""""""""""""""""""""""""
    'couleur 6 : RGB(R5, V5, B5)
    R6 = Int(couleur6 Mod 256)
    V6 = Int((couleur6 Mod 65536) / 256)
    B6 = Int(couleur6 / 65536)
    If couleur6 <> 0 Then nbcolor = nbcolor + 1
    '""""""""""""""""""""""""""""""""""""""""""""""
    'couleur 7 : RGB(R5, V5, B5)
    R7 = Int(couleur7 Mod 256)
    V7 = Int((couleur7 Mod 65536) / 256)
    B7 = Int(couleur7 / 65536)
    If couleur7 <> 0 Then nbcolor = nbcolor + 1
    'définition du nombre de teintes à obtenir entre la couleur 1 et 2 ET 3 ET 4
    longeur = Int(Len(Cells(1, 1)) / nbcolor)  'ON DIVISE LE TEXTE PAR LE NOMBRE DE COULEUR
    'longeur etant le nombre de caracteres qui subiront le dégradé de deux couleur
    nbVal = Int(Len(Cells(1, 1)))  '<-- la cellule A1 contient le mot "developpez" par exemple
    'calcul du différentiel entre chaque teinte pour chaque canal de couleur
    'coloration de chaque lettre du mot contenu en A1
    For i = 1 To nbVal
        If i <= longeur * 1 Then
            difR = Int((R1 - R2) / longeur)
            difV = Int((V1 - V2) / longeur)
            difB = Int((B1 - B2) / longeur)
            R1 = R1 + -difR
            V1 = V1 + -difV
            B1 = B1 + -difB
            Cells(1, 1).Characters(Start:=i, Length:=1).Font.Color = RGB(R1, V1, B1)
 
        ElseIf i >= longeur * 1 And i <= longeur * 2 Then
            difR = Int((R1 - R3) / longeur)
            difV = Int((V1 - V3) / longeur)
            difB = Int((B1 - B3) / longeur)
            R1 = R1 + -difR
            V1 = V1 + -difV
            B1 = B1 + -difB
            Cells(1, 1).Characters(Start:=i, Length:=1).Font.Color = RGB(R1, V1, B1)
 
        ElseIf i >= longeur * 2 And i <= longeur * 3 Then
            difR = Int((R1 - R4) / longeur)
            difV = Int((V1 - V4) / longeur)
            difB = Int((B1 - B4) / longeur)
            R1 = R1 + -difR
            V1 = V1 + -difV
            B1 = B1 + -difB
            Cells(1, 1).Characters(Start:=i, Length:=1).Font.Color = RGB(R1, V1, B1)
 
        ElseIf i >= longeur * 3 Then
            difR = Int((R1 - R5) / longeur)
            difV = Int((V1 - V5) / longeur)
            difB = Int((B1 - B5) / longeur)
            R1 = R1 + -difR
            V1 = V1 + -difV
            B1 = B1 + -difB
            Cells(1, 1).Characters(Start:=i, Length:=1).Font.Color = RGB(R1, V1, B1)
 
        ElseIf i >= longeur * 4 Then
            difR = Int((R1 - R6) / longeur)
            difV = Int((V1 - V6) / longeur)
            difB = Int((B1 - B6) / longeur)
            R1 = R1 + -difR
            V1 = V1 + -difV
            B1 = B1 + -difB
            Cells(1, 1).Characters(Start:=i, Length:=1).Font.Color = RGB(R1, V1, B1)
 
        ElseIf i >= longeur * 5 Then
            difR = Int((R1 - R7) / longeur)
            difV = Int((V1 - V7) / longeur)
            difB = Int((B1 - B7) / longeur)
            R1 = R1 + -difR
            V1 = V1 + -difV
            B1 = B1 + -difB
            Cells(1, 1).Characters(Start:=i, Length:=1).Font.Color = RGB(R1, V1, B1)
           End If
    Next
End Function

qu'en pense tu?
n'y aurait -il pas un moyen de raccourcir le code

[patricktoulon]

bonsoir fring

il semblerait que la fonction ne fonctionne pas avec 4 couleur
je n'arrive pas a comprendre pourquoi??

elle me genere une erreur ici:

Code :

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

1
2
 
rCel.Characters(Start:=posCaract, Length:=1).Font.Color = RGB(R(x - 1) + -difR, V(x - 1) + -difV, B(x - 1) + -difB)

[patricktoulon]

re

l'erreur se précise

il semblerait qu'en mode 3couleur il n'accepte pas les couleur primaire en 2eme arguments

j'ai essayé ceci:

Code :

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

texte_en_degrade rDest, sTxt, sFont, vbYellow, vbGreen, 123654789

ne fonctionne pas

Code :

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

texte_en_degrade rDest, sTxt, sFont, vbYellow, vbred, 123654789

ne fonctionne pas

Code :

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

texte_en_degrade rDest, sTxt, sFont, vbYellow, vbblue, 123654789

ne fonctionne pas


par contre si j'inverse les deux dernière couleur comme ceci:

Code :

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

texte_en_degrade rDest, sTxt, sFont, vbYellow,  123654789,vbred

ca fonctionne et pareil pour les trois couleur primaire

savez vous pourquoi??? parceque la je seche completement


merci pour le retour

[fring]

Je n'ai pas le temps de regarder pour le moment mais dans mon code j'avais ajouté une ligne qui affiche tous les résultats afin de pouvoir vérifier ce que ça donne.
Désactive la ligne qui génère l'erreur et vérifie ce que donne les calculs

Code :

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

1
2
'rCel.Characters(Start:=posCaract, Length:=1).Font.Color = RGB(R(x - 1) + -difR, V(x - 1) + -difV, B(x - 1) + -difB)
Debug.Print "RGB(" & R(x - 1) + -difR & ", " & V(x - 1) + -difV & ", " & B(x - 1) + -difB & ")"

[patricktoulon]

bonsoir

en regardant la fenetre d'execution(debug)

je me suis rendu compte que des fois il y avait une des trois couleur qui arrivait a 1203 par exemple hors c'est 255 le maximum

j'ai donc ajouter 3 variables "rouge,vert,bleu" que je met a 255 si c'est plus avec les dif r,v,b

en esperant que je ne tombe pas sur -quelque chose

comme ceci:

Code :

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

1
2
3
4
5
6
7
8
9
 
difR = difR + Int((r(x - 1) - r(x)) / iLong)
            difV = difV + Int((V(x - 1) - V(x)) / iLong)
            difB = difB + Int((B(x - 1) - B(x)) / iLong)
           rouge = IIf(r(x - 1) + -difR > 255, 255, r(x - 1) + -difR)
         vert = IIf(V(x - 1) + -difV > 255, 255, V(x - 1) + -difV)
        bleu = IIf(B(x - 1) + -difB > 255, 255, B(x - 1) + -difB)
        'on applique la couleur au caractere
           rCel.Characters(Start:=posCaract, Length:=1).Font.Color = RGB(rouge, vert, bleu)

qu'en pense tu ??

[fring]

j'ai essayé ceci:

Code :

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

texte_en_degrade rDest, sTxt, sFont, vbYellow, vbGreen, 123654789

ne fonctionne pas

123654789 n'est pas un Long valable pour une couleur, la valeur la plus élevée est 16777215 pour la couleur blanche