Texte Dégradé de couleurs

sylvanu

XLDnaute Barbatruc
Supporter XLD
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.
VB:
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.
1668520997372.png

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

Pièces jointes

  • Dégradé de couleurs ( calcul entre deux couleurs ) V2.xlsm
    19.2 KB · Affichages: 24

Dranreb

XLDnaute Barbatruc
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.
 

Pièces jointes

  • CouleurClsSylvanu.xlsm
    41 KB · Affichages: 20

Modeste geedee

XLDnaute Barbatruc
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®
:rolleyes: 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 ;)

1694951997515.png

:mad:☹️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


:cool: 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

XLDnaute Barbatruc
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.
 

Pièces jointes

  • CouleurClsRuliann.xlsm
    56.3 KB · Affichages: 7
Dernière édition:

Staple1600

XLDnaute Barbatruc
Bonsour®
:rolleyes: 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 ;)
Code:
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

XLDnaute Barbatruc
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à :
VB:
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 :
Code:
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 :
Code:
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

XLDnaute Barbatruc
Bonsoir @Dranreb

Il y a surement un truc qui m'échappe
J'ai testé ceci
Code:
Sub test()
GradientVertical 14083324, 8696052, 801923
End Sub
Ce qui donne ceci
testDegrad.PNG

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

NB: test sur Office 365
 

Dranreb

XLDnaute Barbatruc
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.
 

Dranreb

XLDnaute Barbatruc
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

XLDnaute Barbatruc
Re

J'essaie d'adapter ton code pour traiter une Shape
Mais ce serait trop simple
Code:
   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

XLDnaute Barbatruc
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

XLDnaute Accro
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