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