PPT vba从Execl 拷贝图表

在PPT 需要引用Execl的COM组件

Dim wkb As Workbook

Sub Change()

    Set wkb = Workbooks.Open("D:\D2_月报基础数据.xlsx")
    Set PPSlide_name = ActivePresentation.Slides(9)
    ActiveWindow.View.GotoSlide (9)
    ClearChart (9)                                     '清理PPT某一页Chart
    Call GetChartByExecl("Total L1", "图表 2")          '从Execl中获取图表
    CommandBars.ExecuteMso "PasteSourceFormatting"
    CommandBars.ReleaseFocus
    For i = 1 To 1: DoEvents: Next

    With ActiveWindow.Selection.ShapeRange
        .Fill.Transparency = 0#
        .Height = 344  '12.14
        .Width = 420   '12.77
        .Top = 150
        .Left = 70
    End With

End Sub

Sub ClearChart(index)
 Set PPSlide = ActivePresentation.Slides(index)
 For Each Myshape In PPSlide.Shapes     '在形状集合内循环
    If Myshape.HasChart Then     '判断形状是否为图表
        Myshape.Chart.Delete
    End If
    Next

End Sub

Sub GetChartByExecl(sheet_name As String, chart_name As String)
    wkb.Sheets(sheet_name).Activate
    wkb.ActiveSheet.ChartObjects(chart_name).Activate
    wkb.ActiveChart.ChartArea.Copy
End Sub