我试图为 PowerPoint 图表创建一个下拉过滤器

Question

我试图为PowerPoint图表创建一个下拉过滤器（我有4个图表）。当我从列表中选择值（水平 x 轴值）时，它应该更新图表直到该值。

我正在使用组合框编写代码，并在其中添加值。 有一个代码指定图表的组合框名称、图表名称、系列（图表内）和值范围（内置 Excel 工作表内）。

但是当我执行时没有得到输出

 Sub UpdateChart()
    Dim sld As Slide
    Dim shp As Shape
    Dim selectedValue As String
    
    ' Set the slide that contains the chart
    Set sld = ActivePresentation.Slides(1)
    
    ' Set the shape name of the ComboBox (change "ComboBox1" to your ComboBox name)
    Set shp = sld.Shapes("ComboBox1")
    
    ' Get the selected value from the ComboBox
    selectedValue = shp.OLEFormat.Object.Object.Value
    
    ' Set the name of the chart data series (change "Series 1" to the appropriate name)
    Dim seriesName As String
    seriesName = "Series 1"
    
    ' Set the data range for the chart (change "A2:A10" to the appropriate range)
    Dim dataRange As String
    dataRange = "A2:A10"
    
    ' Loop through the chart data points and update the series values based on the selected value
    Dim i As Integer
    For i = 1 To sld.Shapes.Count
        If sld.Shapes(i).HasChart Then
            Dim cht As Chart
            Set cht = sld.Shapes(i).Chart
            cht.SeriesCollection(seriesName).Values = Evaluate("IF(" & dataRange & "=""" & selectedValue & """," & dataRange & ", NA())")
        End If
    Next i
End Sub

如果能得到一些帮助就太好了..

谢谢。

Answer 1

PowerPoint 中链接的 Excel 图表有限制。图表数据系列一旦修改，将无法通过VBA恢复。例如，如果在组合框中选择 3，则可以过滤图表系列以仅显示前 3 个点。然而，如果接下来选择5，则无法通过PowerPoint VBA完全恢复原始的完整数据系列。 （如果我缺少更好的方法，请纠正我。）

解决方法是直接在 Excel 中创建动态图表。 PowerPoint 组合框中的用户选择可以传递到 Excel 以过滤图表数据。这允许完全控制图表。

---

STEP1：定义名称（动态引用） |名称|引用| |--|--| |Sheet1!XCate |=OFFSET(Sheet1!$A$2,,,Sheet1!$F$1,1)| |Sheet1!YSeri1 |=OFFSET(Sheet1!$B$2,,,Sheet1!$F$1,1)| |Sheet1!YSeri2 |=OFFSET(Sheet1!$C$2,,,Sheet1!$F$1,1)|

STEP2：更新图表系列公式 |名称|分子式| |--|--| |系列 1|=系列(表 1!$B$1,表 1!XCate,表 1!YSeri1,1)| |系列 2|=系列(表 1!$C$1,表 1!XCate,表 1!YSeri2,2)|

第3步：复制图表并将其作为链接对象粘贴到幻灯片中

第4步：添加PowerPoint VBA代码

---

Option Explicit

Private Sub ComboBox1_GotFocus()
    If ComboBox1.ListCount = 0 Then Call AddItem
End Sub


Private Sub ComboBox1_Change()
    Dim xlApp As Object, xlWK As Object, xlSht
    On Error Resume Next
    Set xlApp = GetObject(, "Excel.Application")
    On Error GoTo 0
    If xlApp Is Nothing Then
        Set xlApp = CreateObject("Excel.Application")
    End If
    On Error Resume Next
    Set xlWK = xlApp.workbooks("Chart.xlsx")
    On Error GoTo 0
    If xlWK Is Nothing Then
        Set xlWK = xlApp.workbooks.Open(ActivePresentation.Path & "\Chart.xlsx")
    End If
    Set xlSht = xlWK.activesheet
    xlSht.Range("F1").Value = Me.ComboBox1.Value
    xlWK.Save
    xlWK.Close
    Call RefreshChart
End Sub

'Refresh chart on slide
Sub RefreshChart()
    Dim cht As Chart
    Dim shp As Shape
    Dim wk
    For Each shp In ActivePresentation.Slides(1).Shapes
        If shp.HasChart Then
            Set cht = shp.Chart
            On Error Resume Next
            Set wk = cht.ChartData.Workbook
            On Error GoTo 0
            cht.Refresh
        End If
    Next
End Sub

' Initial ComboBox, called by GotFocus
Sub AddItem()
    Dim i As Integer
    For i = 1 To 5
        ComboBox1.AddItem CStr(i)
    Next
    Call RefreshChart
End Sub

---

示例数据和图表

动态图