Texte Dégradé de couleurs

[sylvanu]

Il peut être intéressant de gérer en automatique un dégradé de couleurs, en particulier pour des shapes ( dpts dans pays par exemple )
La fonction suivante calcule une couleur entre une couleur de début, une couleur de fin et un ratio.

Function Dégradé(ByVal X#, Color1, Color2) As Double
   Dim R1#, G1#, B1#, R2#, G2#, B2#, R#, G#, B#, Pct#
   Pct = X / 100
   R1 = Color1(0): G1 = Color1(1): B1 = Color1(2)
   R2 = Color2(0): G2 = Color2(1): B2 = Color2(2)
   R = R1 + (R2 - R1) * Pct: G = G1 + (G2 - G1) * Pct: B = B1 + (B2 - B1) * Pct
   Dégradé = RGB(R, G, B)
End Function

En PJ une démo.

Inspiré du site : https://www.gcexcel.com/vba-nuances-de-couleurs/

 

[Dranreb]

Bonsoir.
Le module de classe Couleurs de mon CouleursCls.xlsm calcule des couleurs intermédiaires plus justes car il travaille avec les énergies lumineuses et non avec les niveaux des composantes RVB toujours soumises à un gamma d'écran.

Élaboration et utilisation de jeux de couleurs.

Mise au point facile de jeux de couleurs pour UserForm, Shape et cellules, voire images calculées. Possibilité de capturer un pixel n'importe où sur l'écran. Module de classe Couleur pour utilisation dans d'autres projets VBA.

excel-downloads.com

 

[sylvanu]

Re, Bonjour Dranreb,
Ou encore, voir PJ.

 

[Modeste geedee]

Il peut être intéressant de gérer en automatique un dégradé de couleurs, en particulier pour des shapes ( dpts dans pays par exemple )

Inspiré du site : https://www.gcexcel.com/vba-nuances-de-couleurs/

Bonsour®
🙄 une autre possibilité serait d'utiliser le volet format de la forme, remplissage dégradé , avec choix du nombre de points couleurs couleurs intermédiaires 😉

😡☹️trois fois hélas l'enregistreur de macro (excel 2013) n'est pas loquace et ne permet pas la connaissance des propriétés et méthodes concernées :
position, couleur, transparence


😎 actuellement seul l' API getPixel me permet de connaitre un point quelconque de l'objet ...
sans pouvoir intervenir via VBA sur les caractéristiques des bornes et points intermédiaires...

des idées ???🥰
@+

 

[Dranreb]

Bonjour.
J'ai ajouté une troisième façon de paramétrer les jalons de valeurs selon des notions un peu plus courantes: Angle de teinte, luminosité relative et saturation, bien qu'elle ne permette plus un bon contrôle de la clarté perçue de la surface colorée.

 

[Staple1600]

Bonsour®
🙄 une autre possibilité serait d'utiliser le volet format de la forme, remplissage dégradé , avec choix du nombre de points couleurs couleurs intermédiaires 😉


des idées ???🥰
@+

Bonjour le fil, @Modeste geedee

Ceci fonctionne sur 365

@Modeste geedee
Je te laisse sortir tes crayons de couleurs et ta calculatrice RGB 😉
Trop compliqué pour moi ces histoires de dégradés 😉

Sub gradients()
Set myDocument = ActiveSheet
 Set GradientShapeFill = myDocument.Shapes.AddShape(msoShapeRectangle, 90, 90, 90, 80).Fill
 With GradientShapeFill
    .ForeColor.RGB = RGB(0, 128, 128)
    .OneColorGradient msoGradientHorizontal, 1, 1
    .GradientStops.Insert RGB(255, 0, 0), 0.25
    .GradientStops.Insert RGB(0, 255, 0), 0.5
    .GradientStops.Insert RGB(0, 0, 255), 0.75
 End With
End Sub
Sub mon_gribouillage_du_jour()
Set myDocument = ActiveSheet
 Set GradientShapeFill = myDocument.Shapes.AddShape(msoShapeRectangle, 90, 90, 90, 80).Fill
 With GradientShapeFill
    .ForeColor.RGB = RGB(0, 128, 128)
    .TwoColorGradient msoGradientVertical, 1
    .GradientStops.Insert RGB(255, 0, 0), 0.1
    .GradientStops.Insert RGB(0, 255, 0), 0.3
    .GradientStops.Insert RGB(0, 125, 255), 0.5
    .GradientStops.Insert RGB(125, 0, 255), 0.7
 End With
End Sub

Issue de l'aide en ligne de Microsoft

 

[Dranreb]

trois fois hélas l'enregistreur de macro (excel 2013) n'est pas loquace et ne permet pas la connaissance des propriétés et méthodes concernées :
position, couleur, transparence

D'autant plus que par VBA il est possible de définir plus de 3 taquets !
Les propriétés à toucher sont là :

Public Sub Gradient(ByVal Degree As Long, ByVal Inté As Excel.Interior, ParamArray G())
   Dim CStops As ColorStops, P As Long
   Inté.Pattern = xlPatternLinearGradient
   Inté.Gradient.Degree = Degree
   Set CStops = Inté.Gradient.ColorStops
   CStops.Clear
   For P = 1 To UBound(G) Step 2: CStops.Add(G(P - 1)).Color = G(P): Next P
   End Sub

Exemple d'appel :

Public Sub MFCVertDégradé(Optional ByVal FCn)
   Dim Inté As Interior
   If TypeOf FCn Is FormatCondition Then
      Set Inté = FCn.Interior
   Else
      Set Inté = Selection.FormatConditions(1).Interior
      End If
   Gradient 90, Inté, 0, &H40FF58, 0.375, &H6DFFB7, 0.625, &H6DFFB7, 1, &HFFFFFF
   End Sub

Autre exemple :

Private Sub GradientVertical(ByVal CoulHau As Long, ByVal CoulMil As Long, ByVal CoulBas As Long)
   Dim H As Double, R As Range
   Set R = Selection
   If R.MergeCells Then
      H = 5 / R.Height: If H > 0.25 Then H = 0.25
      Gradient 90, R.Interior, 0, CoulHau, H, CoulMil, 1 - H, CoulMil, 1, CoulBas
   ElseIf R.Rows.Count > 1 Then
      H = 5 / R.Rows(1).RowHeight:            If H > 0.25 Then H = 0.25
      Gradient 90, R.Rows(1).Interior, 0, CoulHau, H, CoulMil, 1, CoulMil
      H = 5 / R.Rows(R.Rows.Count).RowHeight: If H > 0.25 Then H = 0.25
      Gradient 90, R.Rows(R.Rows.Count).Interior, 0, CoulMil, 1 - H, CoulMil, 1, CoulBas
      If R.Rows.Count > 2 Then R.Rows(2).Resize(R.Rows.Count - 2).Interior.Color = CoulMil
   ElseIf R.Style <> "Normal" Then
      H = 5 / R.RowHeight: If H > 0.25 Then H = 0.25
      Gradient 90, R.Style.Interior, 0, CoulHau, H, CoulMil, 1 - H, CoulMil, 1, CoulBas
   Else
      H = 5 / R.RowHeight: If H > 0.25 Then H = 0.25
      Gradient 90, R.Interior, 0, CoulHau, H, CoulMil, 1 - H, CoulMil, 1, CoulBas
      End If
   End Sub

 

[Staple1600]

Bonsoir @Dranreb

Il y a surement un truc qui m'échappe
J'ai testé ceci

Sub test()
GradientVertical 14083324, 8696052, 801923
End Sub

Ce qui donne ceci

La macro MFCVertDégradé génère une erreur 438

NB: test sur Office 365

 

[Dranreb]

Oui le GradientVertical marche à peu près comme je voulais, c'est à dire que seules les zones près des bordures horizontales son dégradées, pour obtenir un effet d'éclairage haut ou bas.
Le MFCVertDégradé marche chez moi sur une plage déjà munie d'une mise en forme conditionnelle.
C'est surtout pour comme exemples d'appels à Gradient que j'indiquai ces procédures.

 

[Staple1600]

Re

J'ai testé MFCVertDégradé sur une plage avec cette MFC

 

[Dranreb]

MFCVertDégradé était plutôt pour une MFC à formule, pour un aspect avec dégradé dans la cellule obéissant à la condition, pas pour une MFC à échelle de couleurs. Je vais voir si j'ai quelque chose pour ces dernières.
Non. Je n'ai rien. Ce qui veux dire que pour en installer une, ce qui est rare, je mets au point les couleurs que je veux dans mon CouleursCls.xlsm et que j'utilise le dialogue normal pour la mettre, avec "autre couleur" où je saisis les valeur RVB calculées.
J'ai peut être un peu confondu ça avec les Interior dégradés, dans cette discussion.
Pour les MFC à échelles de couleurs il semble qu'on ne puisse pas définir plus de 3 bornes.

 

[Staple1600]

Re

J'essaie d'adapter ton code pour traiter une Shape
Mais ce serait trop simple

   Public Sub Gradient_Shape(ByVal Degree As Long, ByVal Inté As Excel.Shape, ParamArray G())
   Dim CStops As ColorStops, P As Long
   Inté.Fill.TwoColorGradient msoGradientHorizontal, 1
'Inté.Pattern = xlPatternLinearGradient
'Inté.Gradient.Degree = Degree
   Set CStops = Inté.Gradient.ColorStops
   CStops.Clear
   For P = 1 To UBound(G) Step 2: CStops.Add(G(P - 1)).Color = G(P): Next P
   End Sub
   Sub test_shp()
   Dim shp As Shape
   Set shp = ActiveSheet.Shapes(1)
    Gradient_Shape 90, shp, 0, &H40FF58, 0.375, &H6DFFB7, 0.625, &H6DFFB7, 1, &HFFFFFF
   End Sub

 

[Dranreb]

Ouais c'est encore complètement différent pour les Shape.
Examiner le FillFormat dans l'explorateur d'objet, il semble avoir des propriétés intéressantes.
Il a des GradientStop qui doivent fonctionner à peu près comme les ColorStop de L'Interior.Gradient

 

[laurent950]

Bonjour @Dranreb

Je suis entrain d'analyser la boîte de dialogue, gestionnaire des mises en forme conditionnelle.
Je suis sur la partie des règles et j'étais effectivement sur les couleurs c'est complexe dont notamment la possibilité de créer des couleurs bi ton qui sont en faite des motifs, j'ai pas eu l'occasion de voir votre module de classe je découvre le poste à l'instant.
J'ai des interrogations sur la classe FormatCondition ?
J'ai fait le code pour les couleurs motifs je reviens ici une fois analyser votre module de classe couleurs @Dranreb
Merci