pasting a picture from excel to powerpoint which fits the layout

Question

I have an Excel Picture as Shape and i want to paste it to mny PowerPoint app which has a Special layout which i have already specified.

 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

As its obvious from the code the layout is already set. Now i want the pastedpic1 to fit completely to the layout of the PowerPoint.

What should i do ?

Answer 1

I had a similar problem but took another approach: I created a PowerPoint template where I added Picture placeholders to the destinations where the pictures have to be inserted. This approach has the advantage, that you can edit the layout in PowerPoint and do not have to fiddle with pixel sizes in the basic code.

The following example is in VBScript but can be transfered to VBA easily:

1. Open the PowerPoint template:

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

2. Select the Placeholder, and paste the picture:

   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. Scale the picture to fit the size of the placeholder:

   slide.Application.CommandBars.ExecuteMso("PictureFitCrop")
   

Answer 2

To scale the shape myShape to the size of the slide, use this:

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

Note that depending on the aspect ratio of your shape and slide, stretching may occur. This can be dealt with using the cropping methods.