Question

我拼凑了一个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”函数返回一个形状对象，可用于调整大小或重新定位。

例如：

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

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

ppShape.Height = xyz
ppShape.Top = abc

等等。

希望这会有所帮助。 Vikas 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

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

它也适用于DataType：= 10项

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

2 个答案: