PowerPoint VBA - 基于横轴数据标签的图表颜色

Question

我正在制作一个 PowerPoint 演示文稿，其中包含多张幻灯片，每张幻灯片有 4 个图表。我在季度和月份使用水平轴标签，它们具有不同的条形颜色。我运行遇到的问题是，当我对图表使用 "Keep Source Formatting and Link Data" 时，值是正确的，但是当标签发生变化时（例如几个月的过渡），颜色是错误的。我认为通过 PowerPoint 使用 VBA 是确定颜色的一个很好的解决方案，但我遇到了 Excel 没有的挑战。这是代码：

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

我想要为每个图表做的是，任何带有 Q1、Q2、Q3 和 Q4 的标签都将用红色填充栏。 YTD 将显示为蓝色，其他所有内容将显示为绿色。使用 Excel，我可以将 cht 指定为对象，但我不确定它在 PowerPoint 中是什么。

如有任何帮助，我们将不胜感激。谢谢。

Chart Example

Answer 1

这对我有用。遍历 DataLabels 是行不通的，因为它们显示值（3.2、4.1 等）。相反，您可以遍历轴的 CategoryNames。

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

PowerPoint VBA - 基于横轴数据标签的图表颜色

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

powerpoint

vba