Monsieur Excel
Pour tout savoir faire sur Excel !

08 décembre 2016

Création d’un « waffle chart » (a)

Un concurrent éventuel du camembert, une référence en matière de cuisine Excel, est le « waffle chart », dont je ne connais pas – s’il existe – le nom français. La traduction du mot nous donne le choix entre Gaufre, Baratin et Remplissage… Aucun de ces trois termes ne m’excite particulièrement…

Le débat entre ceux qui préfèrent le camembert et les fanas du waffle chart est sans fin, et je ne vais donc pas m'y lancer.... Sachez simplement que vous avez aussi cette possibilité.

Le modèle ci-dessous est dû à mon collègue MVP américain Matt Mickle. La couleur de la police en B4:B5 détermine celle des billes du graphe. Dans les colonnes de P à R, il y a six zones de texte qui sont liées aux cellules des colonnes B:D.


Une macro évenementielle redessine le graphe chaque fois que l’on modifie quoi que ce soit dans l’onglet. Voici le code de cette macro :

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim CatVal1 As Integer: Dim ShpLp As Integer: Dim Cnt As Integer
    Dim Cat1Color  As Long: Dim Cat2Color As Long
   
    If Intersect(Target, Range("B5:C6")) Is Nothing Or Target.Cells.Count > 1 Then Exit Sub
   
        On Error Resume Next
        CatVal1 = 100 * Range("D5")
        Cat1Color = Range("B5").Font.Color
        Cat2Color = Range("B6").Font.Color
       
        For ShpLp = 1 To 100
            With Sheets("ShapeTest").Shapes("Oval " & ShpLp)
                 Cnt = Cnt + 1
                 If Cnt <= CatVal1 Then
                    .Fill.ForeColor.RGB = RGB(Cat1Color Mod 256, _
                           ((Cat1Color \ 256) Mod 256), (Cat1Color \ 65536))
                 Else
                    .Fill.ForeColor.RGB = RGB(Cat2Color Mod 256, _
                           ((Cat2Color \ 256) Mod 256), (Cat2Color \ 65536))
                 End If
            End With
        Next ShpLp

        'Change Font Color of TextBoxes
        With Sheets("ShapeTest")
            .TextBoxes("TextBox 101").Font.Color = Cat1Color
            .TextBoxes("TextBox 103").Font.Color = Cat1Color
            .TextBoxes("TextBox 102").Font.Color = Cat2Color
            .TextBoxes("TextBox 104").Font.Color = Cat2Color
        End With
        On Error GoTo 0

    CatVal1 = Empty
    ShpLp = Empty
    Cnt = Empty
    Cat1Color = Empty
    Cat2Color = Empty
   
End Sub

rédigé par Hervé Thiriez | 0 commentaire(s)