將圖片從 excel 粘貼到適合布局的 powerpoint

Question

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

我應該怎么辦 ？

Answer 1

要將形狀myShape縮放到幻燈片的大小，請使用以下命令：

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

請注意，根據形狀和幻燈片的縱橫比，可能會發生拉伸。 這可以使用裁剪方法來處理。

Answer 2

我遇到了類似的問題，但采取了另一種方法：我創建了一個 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")