vba 使用vba调整powerpoint中excel粘贴对象的大小

Resizing a excel pasted object in powerpoint with vba

提问by ben.ratcliffe

I've cobbled together a VBA script (I'm no expert, but thanks to the kind folks around here, I've been able to get something together and mostly working) to copy from multiple excel sheets into a powerpoint file (used a template, as you will see from the code.

我拼凑了一个 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

My problem is: how do I resize/reposition the object once it's been pasted?

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

回答by Vikas

The function "PasteSpecial" returns a shape object, which you can use to resize or reposition.

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

For example:

例如：

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

Then you can use this shape object to resize it. For example:

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

ppShape.Height = xyz
ppShape.Top = abc

etc etc.

等等等等

Hope this helps. Vikas B

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

回答by JIm C

This has been working for me:

这对我有用：

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

Note the variables are set locally to place the image where I want it in relation to the slide. You can easily replace with integers.

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

It also works for DataType:=10 items as well

它也适用于 DataType:=10 项