我有一个 Excel 图片作为形状,我想将它粘贴到我已经指定的特殊布局的 mny PowerPoint 应用程序中。
Sub ExcelShapePowerpoint()
Dim PowerPointApp As Object
Dim myPresentation As Object
Dim mySlide As Object
Dim myShape As Object
Dim pastedPic1 As Shape
Set DestinationSheet1 = Workbooks("myExcelFile.xlsm").Sheets("myExcelSheet")
Set pastedPic1 = DestinationSheet1.Shapes(10)
On Error Resume Next
Set PowerPointApp = GetObject(class:="PowerPoint.Application")
If PowerPointApp Is Nothing Then Set PowerPointApp = CreateObject(class:="PowerPoint.Application")
'Handle if the PowerPoint Application is not found
If Err.Number = 429 Then
MsgBox "PowerPoint could not be found, aborting."
Exit Sub
End If
On Error GoTo 0
Application.ScreenUpdating = False
Set myPresentation = PowerPointApp.Presentations.Add
Set mySlide = myPresentation.Slides.Add(1, 11) '11 = ppLayoutTitleOnly
With myPresentation.PageSetup
.SlideWidth = 961
.SlideHeight = 540
End With
pastedPic1.Copy
mySlide.Shapes.PasteSpecial DataType:=2 '2 = ppPasteEnhancedMetafile
Set myShape = mySlide.Shapes(mySlide.Shapes.Count)
'Set position:
myShape.Left = -15
myShape.Top = 11
PowerPointApp.Visible = True
PowerPointApp.Activate
Application.CutCopyMode = False
End Sub
从代码中可以明显看出,布局已经设置好了。现在我希望 pasteedpic1 完全适合 PowerPoint 的布局。
我应该怎么办 ?
最佳答案
缩放形状我的形状 到幻灯片的大小,使用这个:
With myShape
.Top = 0
.Left = 0
.Width = ActivePresentation.PageSetup.SlideWidth
.Height = ActivePresentation.PageSetup.SlideHeight
End With
请注意,根据形状和幻灯片的纵横比,可能会发生拉伸(stretch)。这可以使用裁剪方法来处理。
关于vba - 将图片从 excel 粘贴到适合布局的 powerpoint,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/35720524/