excel图表数据发送到ppt

代码转载自：《Excel2016高级VBA编程宝典》
工作中需要的ppt有固定的汇报内容，在这本书中找到了相关的代码，分享下~~
内容仅供参考学习，版权相关请联系删除…

Sub Macro100()

'Step 1:  Declare your variables
    Dim PP As PowerPoint.Application
    Dim PPPres As PowerPoint.Presentation
    Dim PPSlide As PowerPoint.Slide
    Dim i As Integer


'Step 2:  Check for charts; exit if no charts exist
    Sheets("Slide Data").Select
    If ActiveSheet.ChartObjects.Count < 1 Then
    MsgBox "No charts existing the active sheet"
    Exit Sub
    End If
    

'Step 3:  Open PowerPoint and create new presentation
    Set PP = New PowerPoint.Application
    Set PPPres = PP.Presentations.Add
    PP.Visible = True


'Step 4:  Start the loop based on chart count
    For i = 1 To ActiveSheet.ChartObjects.Count


'Step 5:  Copy the chart as a picture
    ActiveSheet.ChartObjects(i).Chart.CopyPicture _
    Size:=xlScreen, Format:=xlPicture
    Application.Wait (Now + TimeValue("0:00:1"))


'Step 6:  Count slides and add new slide as next available slide number
    ppSlideCount = PPPres.Slides.Count
    Set PPSlide = PPPres.Slides.Add(SlideCount + 1, ppLayoutBlank)
    PPSlide.Select


'Step 7:  Paste the picture and adjust its position; Go to next chart
    PPSlide.Shapes.Paste.Select
    PP.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
    PP.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True
    Next i


'Step 8:  Memory Cleanup
    Set PPSlide = Nothing
    Set PPPres = Nothing
    Set PP = Nothing

End Sub