清华大佬耗费三个月吐血整理的几百G的资源,免费分享!....>>>
Sub RangeToPresentation()
' Set a VBE reference to Microsoft Excel Object Library
Dim XLApp As Excel.Application
Dim PPSlide As Slide
' Reference existing instance of Excel
Set XLApp = GetObject(, "Excel.Application")
' Make sure a range is selected
If Not TypeName(XLApp.Selection) = "Range" Then
MsgBox "Please select a worksheet range and try again.", _
vbExclamation, "No Range Selected"
Else
' Can only paste into slide view
Application.ActiveWindow.ViewType = ppViewSlide
' Reference active slide
Set PPSlide = ActivePresentation.Slides _
(Application.ActiveWindow.Selection.SlideRange.SlideIndex)
' Copy the range as a piicture
XLApp.Selection.CopyPicture Appearance:=xlScreen, _
Format:=xlPicture
' Paste the range
PPSlide.Shapes.Paste.Select
' Align the pasted range
Application.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
Application.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True
' Clean up
Set PPSlide = Nothing
End If
Set XLApp = Nothing
End Sub