Is there a way to copy shapes from excel and paste them as same shape type in Powerpoint?

Question

Basically, I'm trying to use a range in Excel to produce automatically a set of custom layouts in PowerPoint. Following this code, I'm able to loop throught all the shapes in a predefined range, copying those who are within predefined range to a custom layout in a newly created presentation.

My problem is anything it copies from Excel to Powerpoint becomes picture instead of shape.

Here's a part of my code:

Dim WS As Worksheet
Dim PPT As Object
Dim PRES As Object
Dim PPTlay As Object
Dim shp As Shape
Dim r as Range

Set WS = ActiveWorksheet
Set r = WS.Range("A1:L36")

'New PPT Presentation
On Error Resume Next

Set PPT = GetObject(class:="PowerPoint.Application")

On Error GoTo 0

If PPT Is Nothing Then Set PPT = CreateObject(class:="PowerPoint.Application")

Set PRES = PPT.Presentations.Add
PRES.PageSetup.SlideSize = ppSlideSizeOnScreen

'Delete all layouts in slideMaster
For i = PRES.SlideMaster.CustomLayouts.Count To 1 Step -1
    PRES.SlideMaster.CustomLayouts(i).Delete
Next i

'Create new custom layout
Set PPTlay = PRES.SlideMaster.CustomLayouts.Add(PRES.SlideMaster.CustomLayouts.Count + 1)

'Delete all placeholders and shapes on newly created custom layout
For i = PPTlay.Shapes.Count To 1 Step -1
    PPTlay.Shapes(i).Delete
Next i

'Loop through all shape in Excel range "r" 
'Copy/paste to powerpoint custom Layout
For Each shp In WS.Shapes
    If Not Intersect(WS.Range(shp.TopLeftCell, shp.BottomRightCell), r) Is Nothing Then
        shp.Select
        Selection.Copy
        PPTlay.Shapes.Paste
        i = PPTlay.Shapes.Count
        PPTlay.Shapes(i).LEFT = shp.LEFT
        PPTlay.Shapes(i).TOP = shp.TOP
    End If
Next shp

I also tried to select all shapes in range, copy selection, then paste it in the presentation but the same problem occurred.

Any hint would be welcome.

Thanks!

Answer 1

Try

PPTlay.Shapes.PasteSpecial DataType:= ppPasteShape

instead of

PPTlay.Shapes.Paste