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

Question

我正在制作一个PowerPoint演示文稿，其中包括多张幻灯片，每张幻灯片有4张图表。我将水平轴标签用于季度和月份，它们具有不同的条形颜色。我遇到的问题是，当我对图表使用“保持源格式和链接数据”时，值是正确的，但是当标签更改时（例如，以月为单位的过渡），颜色是错误的。我认为通过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