Extract Powerpoint chart Min and Max values

Question

I am trying to create a VBA code which can help me open a presentation, go to each slide, check for a chart and then copy its min and max value in an excel sheet. I have a 40+ slides presentation with multiple chart and this code will help me to check if the axis values in all the chart are consistent. Below is the code I am working on. So far, able to open the presentation but not able to open the chart and copy the values to excel. Please help, new to VBA coding

Sub CopySlidechart()

    Dim ppApp As PowerPoint.Application
    Dim ppPres As PowerPoint.Presentation
    Dim ppSlide As PowerPoint.Slide
    Dim ppPlaceHolder As PowerPoint.Shape
    Dim oRow As Long

    Set ppApp = CreateObject("PowerPoint.Application")
    Set ppApp = New PowerPoint.Application
    ppApp.Visible = msoTrue
    
    Dim input_path As String
    input_path = ThisWorkbook.Worksheets("Sheet1").Range("B1")

    Set ppPres = ppApp.Presentations.Open(input_path)

    oRow = 6
    For Each ppSlide In ppPres.Slides
        For Each ppPlaceHolder In ppSlide.Shapes
            If ppPlaceHolder.HasChart Then
            ThisWorkbook.Worksheets("Sheet1").Range(oRow, "B").Value = ChartObject.Chart.Axes(xlCategory).MaximumScale
            ThisWorkbook.Worksheets("Sheet1").Cells(oRow, "C").Value = ChartObject.Chart.Axes(xlCategory).MinimumScale
    oRow = oRow + 1
                oRow = oRow + 1
                Exit For
            End If
        Next ppPlaceHolder
    Next ppSlide

End Sub

score 0 · Answer 1 · answered Mar 20 '23 at 11:02

Try the following code. There is no ChartObject in Powerpoint, only a Chart (which is similar to ChartObject.Chart in Excel). Note that you need to check for Axes(xlValue) as you want to read min and max from the y-Axis.

Dim ws As Worksheet
set ws = ThisWorkbook.Worksheets("Sheet1") 
oRow = 6
For Each ppSlide In ppPres.Slides
    For Each ppPlaceHolder In ppSlide.Shapes
        If ppPlaceHolder.HasChart Then
            Dim chart as Chart, axis as Axis
            Set chart = ppPlaceHolder.Chart
            Set axis = chart.Axes(xlValue)

            ws.Range(oRow, "B").Value = axis.MaximumScale
            ws.Range(oRow, "C").Value = axis.MinimumScale
            oRow = oRow + 1
        End If
    Next ppPlaceHolder
Next ppSlide

Extract Powerpoint chart Min and Max values

1 Answers1