用vba在PowerPoint中调整excel粘贴对象的大小

我拼凑了一个VBA脚本（我不是专家，但是感谢周围那些善良的人，我已经能够把一些东西放在一起，大部分工作）从多个Excel表复制到一个PowerPoint文件（使用模板，你会从代码中看到。

Sub ATestPPTReport() Dim PPApp As PowerPoint.Application Dim PPSlide As PowerPoint.Slide Dim PPPres As PowerPoint.Presentation Set PPApp = CreateObject("Powerpoint.Application") Dim SlideNum As Integer Dim PPShape As PowerPoint.Shape Set XLApp = GetObject(, "Excel.Application") ''define input Powerpoint template Dim strPresPath As String, strExcelFilePath As String, strNewPresPath As String ''# Change "strPresPath" with full path of the Powerpoint template strPresPath = "C:\template.ppt" ''# Change "strNewPresPath" to where you want to save the new Presentation to be created strNewPresPath = "C:\macro_output-" & Format(Date, "dd-mmm-yyyy") & ".ppt" Set PPPres = PPApp.Presentations.Open(strPresPath) PPPres.Application.Activate PPApp.Visible = True ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ''define destination slide SlideNum = 1 PPPres.Slides(SlideNum).Select Set PPShape = PPPres.Slides(SlideNum).Shapes("slide1box") Set PPSlide = PPPres.Slides(PPApp.ActiveWindow.Selection.SlideRange.SlideIndex) ''define source sheet Sheets("Info1").Activate 'copy/paste from XLApp.Range("Info1Block").Copy PPSlide.Shapes.PasteSpecial DataType:=ppPasteOLEObject, Link:=msoFalse ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ''define destination slide SlideNum = 2 PPPres.Slides(SlideNum).Select ' Set PPShape = PPPres.Slides(SlideNum).Shapes("slide2box") Set PPSlide = PPPres.Slides(PPApp.ActiveWindow.Selection.SlideRange.SlideIndex) ''define source sheet Sheets("Info2").Activate 'copy/paste from XLApp.Range("Info2Block").Copy PPSlide.Shapes.PasteSpecial DataType:=ppPasteOLEObject, Link:=msoFalse ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' Close presentation PPPres.SaveAs strNewPresPath 'PPPres.Close 'Quit PowerPoint 'PPApp.Quit ' MsgBox "Presentation Created", vbOKOnly + vbInformation ' Clean up Set PPSlide = Nothing Set PPPres = Nothing Set PPApp = Nothing End Sub 

我的问题是：如何粘贴对象后调整/重新定位对象？

Answer 1

“PasteSpecial”函数返回一个形状对象，您可以使用它来resize或重新定位。

例如：

 Dim ppShape as PowerPoint.Shape set ppShape = PPSlide.Shapes.PasteSpecial(DataType:=ppPasteOLEObject, Link:=msoFalse) 

然后你可以使用这个形状对象来调整它的大小。 例如：

 ppShape.Height = xyz ppShape.Top = abc 

等等

希望这可以帮助。 维卡斯B.

Answer 2

这一直在为我工作：

 Set shp = myPresentation.Slides(x).Shapes.PasteSpecial(DataType:=2) shp.Left = topLeft + 1 shp.Top = midTop + 1 shp.Width = midLeft - topLeft - 1 

请注意，variables是在本地设置的，以便将图像放置在与幻灯片相关的位置。 你可以很容易地用整数replace。

它也适用于DataType：= 10项目