使用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

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

函数“PasteSpecial”返回一个形状对象，您可以使用它调整或重新定位大小

例如：

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

ppShape.Height = xyz
ppShape.Top = abc

然后可以使用此形状对象调整其大小。例如：

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

ppShape.Height = xyz
ppShape.Top = abc

等等

希望这有帮助。

---

Vikas B

这对我来说很有效：

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

请注意，这些变量是在本地设置的，用于将图像放置在与幻灯片相关的位置。您可以轻松地用整数替换

---

它也适用于数据类型：=10项

谢谢您的帮助，这很可能是我自己的经验不足，但它返回了一个运行时13错误（类型不匹配），设置为ppShape=PPSlide.Shapes.PasteSpecial（数据类型：=ppPasteOLEObject，链接：=msoFalse）line.Thinks？您能否确认您是否将变量声明为与PowerPoint.Shape相同的Dim ppShape而不是与Shape相同的Dim ppShape？如果仍然出现错误，请尝试将变量声明为Dim ppShape as Object以避免类型不匹配错误。Vikas！非常感谢！我将Dim ppShape更改为一个对象，并使其正常工作！非常感谢在将var定义为对象时，您失去了intellisense的好处，实际上，这只是掩盖了基本问题，即PasteSpecial返回的是ShapeRange，而不是Shape，因此会出现类型不匹配错误。Use.PasteSpecial（parameters）（1）而是返回新粘贴的shaperange中的第一项，该项将是单个形状；没有错误，您可以将该形状作为一个形状使用。