清华大佬耗费三个月吐血整理的几百G的资源,免费分享!....>>>
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