PPT vba从Execl 拷贝图表

在PPT 需要引用Execl的COM组件

1Dim wkb As Workbook
2
3Sub Change()
4   
5    Set wkb = Workbooks.Open("D:\D2_月报基础数据.xlsx")
6    Set PPSlide_name = ActivePresentation.Slides(9)
7    ActiveWindow.View.GotoSlide (9)
8    ClearChart (9)                                     '清理PPT某一页Chart
9    Call GetChartByExecl("Total L1", "图表 2")          '从Execl中获取图表
10    CommandBars.ExecuteMso "PasteSourceFormatting"
11    CommandBars.ReleaseFocus
12    For i = 1 To 1: DoEvents: Next
13    
14    With ActiveWindow.Selection.ShapeRange
15        .Fill.Transparency = 0#
16        .Height = 344  '12.14
17        .Width = 420   '12.77
18        .Top = 150
19        .Left = 70
20    End With
21    
22    
23 
24End Sub
25
26
27Sub ClearChart(index)
28 Set PPSlide = ActivePresentation.Slides(index)
29 For Each Myshape In PPSlide.Shapes     '在形状集合内循环
30    If Myshape.HasChart Then     '判断形状是否为图表
31        Myshape.Chart.Delete
32    End If
33    Next
34
35End Sub
36
37Sub GetChartByExecl(sheet_name As String, chart_name As String)
38    wkb.Sheets(sheet_name).Activate
39    wkb.ActiveSheet.ChartObjects(chart_name).Activate
40    wkb.ActiveChart.ChartArea.Copy
41End Sub