清华大佬耗费三个月吐血整理的几百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