删除电源点幻灯片中的现有图表，使用VBA替换新图表

Question

我正在编写VBA代码，以便将图表从excel复制到PowerPoint。我的代码将首先从PowerPoint幻灯片中删除现有图表，然后从excel复制粘贴图表。

不幸的是，一些图表在PowerPoint中被命名为“内容占位符xx”，因为在表示中的现有图表不会被删除。既然内容占位符可以是表格/现成的形状/chart，那么我如何测试内容占位符是图表还是其他形状呢？

如有任何指导，将不胜感激。

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

Answer 1

您可以使用形状对象的HasChart属性测试形状是否包含图表.

If ActiveSlide.Shapes(i).HasChart Then

如果您还想测试图表的名称，在测试形状是否有图表之后.

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

Answer 2

使用Shapes.Chart属性

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