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