Search code examples
vbapowerpoint

PowerPoint VBA - Chart Color Based on Data Label in Horizontal Axis


I am working on a PowerPoint presentation which consists of multiple slides with 4 charts each. I am using horizontal axis labels for quarters and months, which have different bar colors. The issue I am running across is that when I use "Keep Source Formatting and Link Data" for the charts, values are correct however when the labels change (such as a transition in months), the colors are wrong. I figure using VBA through PowerPoint would be a good solution to determine the colors, but I am having challenges that I did not have with Excel. Here is the code:

Sub test()

Dim pptChart As Chart
Dim pptChartData As ChartData
Dim pptWorkbook As Object
Dim sld As slide
Dim shp As shape
Dim pt As Point
Dim xv As Variant
Dim i As Integer

For Each sld In ActivePresentation.Slides
For Each shp In sld.Shapes

        i = 0
        For Each xv In Chart.SeriesCollection(1).Points(1).DataLabel.Text   'cht.chart.seriescollection(1).xvalues
            i = i + 1
            Select Case xv
            Case "1", "Q1", "Q2", "Q3", "Q4"
                Set pt = cht.Chart.SeriesCollection(1).Points(i)
                pt.Interior.Color = RGB(192, 0, 0)
            Case "YTD"
                Set pt = cht.Chart.SeriesCollection(1).Points(i)
                pt.Interior.Color = RGB(33, 26, 166)
            Case Else
                Set pt = cht.Chart.SeriesCollection(1).Points(i)
                pt.Interior.Color = RGB(0, 176, 80)
            End Select
        Next

Next
Next

Set pptWorkbook = Nothing
Set pptChartData = Nothing
Set pptChart = Nothing

End Sub

What I'm trying to do is for each chart, any labels with Q1, Q2, Q3, and Q4 will have a red fill for the bar. YTD will be in blue, and everything else will be in green. With Excel, I was able to assign cht as object, but I'm not sure what it is in PowerPoint.

Any assistance is appreciated. Thank you.

Chart Example


Solution

  • This worked for me. Looping through the DataLabels would not work, since they show the values (3.2, 4.1, etc.) Instead, you can loop through the CategoryNames of your axis.

    Sub Test()
        Dim sld As Slide
        Dim shp As Shape
        Dim cht As Chart
        Dim cats As Variant
        Dim j As Integer
    
        For Each sld In ActivePresentation.Slides
            For Each shp In sld.Shapes
                If shp.Type = msoChart Then             
                    cats = shp.Chart.Axes(xlCategory).CategoryNames
    
                    For j = LBound(cats) To UBound(cats)
                        With shp.Chart.SeriesCollection(1).Points(j).Format.Fill.ForeColor
                            Select Case cats(j)
                                Case "1", "Q1", "Q2", "Q3", "Q4"
                                    .RGB = RGB(192, 0, 0)
                                Case "YTD"
                                    .RGB = RGB(33, 26, 166)
                                Case Else
                                    .RGB = RGB(0, 176, 80)
                            End Select
                        End With
                    Next j
                End If
            Next shp
        Next sld
    End Sub
    

    enter image description hereenter image description here