删除 Power Point 幻灯片中的现有图表并使用 VBA 替换为新图表

Question

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

不幸的是，某些图表在 PowerPoint 中被命名为“Content Placeholder xx”，因为演示文稿中的现有图表不会被删除。由于内容占位符可以是表格/现成的形状/图表，如何测试内容占位符是图表还是其他形状？

任何指导将不胜感激

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

您可以使用 Shape 对象的 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