2

我有一个 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 的布局。

我应该怎么办 ？

4

2 回答 2

0

要将形状myShape缩放到幻灯片的大小，请使用以下命令：

With myShape
  .Top = 0
  .Left = 0
  .Width = ActivePresentation.PageSetup.SlideWidth
  .Height = ActivePresentation.PageSetup.SlideHeight
End With

请注意，根据形状和幻灯片的纵横比，可能会发生拉伸。这可以使用裁剪方法来处理。

于 2016-03-02T14:55:36.200 回答
0

我遇到了类似的问题，但采取了另一种方法：我创建了一个 PowerPoint 模板，在其中将图片占位符添加到必须插入图片的目标位置。这种方法的优点是您可以在 PowerPoint 中编辑布局，而不必在基本代码中摆弄像素大小。

以下示例使用 VBScript，但可以轻松转换为 VBA：

  1. 打开 PowerPoint 模板：

    Dim powerPoint, presentation
Set powerPoint = CreateObject("PowerPoint.Application")    
Set presentation = powerPoint.Presentations.open("C:\template.pptx")

  2. 选择占位符，然后粘贴图片：

    Dim slide, view, image, placeholder
Set view = m_presentation.Windows(1).View
Set slide = m_presentation.Slides(slideId)
view.GotoSlide(slide.SlideIndex)
Set placeholder = slide.Shapes(shapeName)
placeholder.Select()
view.Paste()
slide.Application.CommandBars.ExecuteMso("PictureFitCrop")

  3. 缩放图片以适合占位符的大小：

    slide.Application.CommandBars.ExecuteMso("PictureFitCrop")
于 2017-10-18T07:03:51.083 回答