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.
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