VBA粘贴Excel Chart图表到当前PowerPoint幻灯片中（早期绑定）

2014/12/07 40223
Sub ChartToPresentation()
' Uses Early Binding to the PowerPoint Object Model
' Set a VBE reference to Microsoft PowerPoint Object Library

Dim PPApp As PowerPoint.Application
Dim PPPres As PowerPoint.Presentation
Dim PPSlide As PowerPoint.Slide

' Make sure a chart is selected
If ActiveChart Is Nothing Then
    MsgBox "Please select a chart and try again.", vbExclamation, _
        "No Chart Selected"
Else
    ' Reference existing instance of PowerPoint
    Set PPApp = GetObject(, "Powerpoint.Application")
    ' Reference active presentation
    Set PPPres = PPApp.ActivePresentation
    PPApp.ActiveWindow.ViewType = ppViewSlide
    ' Reference active slide
    Set PPSlide = PPPres.Slides _
        (PPApp.ActiveWindow.Selection.SlideRange.SlideIndex)
    
    ' Copy chart as a picture
    ActiveChart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, _
        Format:=xlPicture

    ' Paste chart
    PPSlide.Shapes.Paste.Select
    
    ' Align pasted chart
    PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
    PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True

    ' Clean up
    Set PPSlide = Nothing
    Set PPPres = Nothing
    Set PPApp = Nothing
End If

End Sub

'定位图上的幻灯片
'这个程序使用下面的代码块的中心图片图表在幻灯片。
    ' Align pasted chart
    PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
    PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True

'你可以替换下面的代码块定位图在特定位置上的幻灯片。在这种情况下，左边缘的100分图位于左侧的幻灯片的上边缘与图定位50点从顶部的幻灯片。
' Position pasted chart
PPApp.ActiveWindow.Selection.ShapeRange.Left = 100 PPApp.ActiveWindow.Selection.ShapeRange.Top = 50
代码片段
