Question

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

很遗憾，某些图表在PowerPoint中被命名为“ 内容占位符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

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

2 个答案: