1

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

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

4

2 回答 2

2

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

例如：

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

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

ppShape.Height = xyz
ppShape.Top = abc

等等等等

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

于 2013-07-25T16:31:52.097 回答
0

这一直对我有用：

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

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

它也适用于 DataType:=10 项

于 2015-06-05T16:33:10.110 回答