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

Dans le dernier post, nous avons vu comment fonctionnait le waffle chart avec deux catégories.

Voici aujourd’hui un exemple de waffle chart à trois catégories, ainsi que le code VBA associé.

Le code original est dû au MVP américain Matt Mickle. Je l’ai seulement un peu simplifié et compacté.

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