Monsieur Excel
Pour tout savoir faire sur Excel !

18 décembre 2016

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

Pour terminer la série sur les waffle charts, voici enfin un waffle chart à quatre catégories.

Pour ceux qui prennent le train en route, sachez que nous avons simplement entré une puce « ● » dans chaque cellule de B5 à P14, en Calibri taille 36, et que c’est la macro ci-dessous, liée à la feuille, qui met tout cela en couleur.

Ce sont les couleurs des cellules B5:B8 qui sont prises comme modèles et reproduites dans le « graphe ».


Voici le code VBA, une fois encore grâce au MVP américain Matt Mickle :

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim CatVal1 As Integer: Dim CatVal2 As Integer
    Dim ColLp As Integer: Dim RowLp As Integer: Dim Cnt As Integer
    Dim Cat1Color  As Long: Dim Cat2Color As Long: Dim Cat3Color As Long
     
    If Intersect(Target, Range("B5:C7")) Is Nothing Or Target.Cells.Count > 1 Then Exit Sub
   
        On Error Resume Next
        CatVal1 = 100 * Range("D5")
        CatVal2 = 100 * Range("D6") + CatVal1
        Cat1Color = Range("B5").Font.Color
        Cat2Color = Range("B6").Font.Color
        Cat3Color = Range("B7").Font.Color
   
        For RowLp = 5 To 14
            For ColLp = 7 To 16
                Cnt = Cnt + 1
                    If Cnt <= CatVal1 Then
                        Cells(RowLp, ColLp).Font.Color = Cat1Color
                    ElseIf Cnt <= CatVal2 Then
                        Cells(RowLp, ColLp).Font.Color = Cat2Color
                    Else
                        Cells(RowLp, ColLp).Font.Color = Cat3Color
                    End If
            Next ColLp
        Next RowLp
       
        'Change Font Color of TextBoxes
        With Sheets("3CategoryWaffleChart")
            .TextBoxes("TextBox 2").Font.Color = Cat1Color
            .TextBoxes("TextBox 6").Font.Color = Cat1Color
            .TextBoxes("TextBox 3").Font.Color = Cat2Color
            .TextBoxes("TextBox 7").Font.Color = Cat2Color
            .TextBoxes("TextBox 4").Font.Color = Cat3Color
            .TextBoxes("TextBox 8").Font.Color = Cat3Color
        End With
        On Error GoTo 0

End Sub

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