Delete existing chart in Power Point slide and replace by new chart using VBA

1
votes

I am writing VBA code to copy paste chart from excel to PowerPoint. My code would first delete the existing chart from the PowerPoint slide before copy pasting the chart from excel.

Unfortunately some of charts are named as “Content Placeholder xx” in PowerPoint due to which existing chart in presentation wouldn’t get deleted. Since content placeholder can be table/ ready-made shape /chart, how can I test if content place holder is chart or some other shape?

Any guidance will be appreciated

Sub Powerpoint_Slide_MoveChart()

    '// General declaration
    Dim ppt             As PowerPoint.Application
    Dim ActiveSlide     As PowerPoint.Slide
    Dim Cht             As ChartObject
    Dim i               As Integer

    '// Set powerpoint application
    Set ppt = GetObject(, "PowerPoint.Application")

    '// Check if more then single powerpoint open
    If ppt.Presentations.Count > 1 Then
        MsgBox "Please close all other powerpoints except the one you would like to puiblish."
        Exit Sub
    End If

    '// Set active slide as slide 9
    Set ActiveSlide = ppt.ActivePresentation.Slides(9)
    ppt.ActiveWindow.View.GotoSlide (9)
    Set Cht = ActiveSheet.ChartObjects("ChartSlide9")

    '// Delete existing chart
    For i = 1 To ActiveSlide.Shapes.Count
        If Left(UCase(ActiveSlide.Shapes(i).Name), 5) = "CHART" Then
            ActiveSlide.Shapes(i).Delete
            Exit For
        End If
    Next i
 End Sub
2
vbaexcelpowerpoint

2 Answers

2
votes

You can test whether a shape contains a chart by using the HasChart property of the Shape object...

If ActiveSlide.Shapes(i).HasChart Then

If you also wanted to test for the name of the chart, after testing whether the shape had a chart...

If ActiveSlide.Shapes(i).Chart.Name = "Chart Name" Then
1
votes

Use the Shapes.Chart Property

Sub Sample()
    Dim chrt As Chart

    With ActivePresentation
        For i = 1 To .Slides(1).Shapes.Count
            On Error Resume Next
            Set chrt = .Slides(1).Shapes(i).Chart
            On Error GoTo 0

            If Not chrt Is Nothing Then
                MsgBox "Guess what? " & .Slides(1).Shapes(i).Name & " is a chart"
                Set chrt = Nothing
            Else
                MsgBox .Slides(1).Shapes(i).Name & " is not a chart"
            End If
        Next i
    End With
End Sub