How to paste images from Excel to PowerPoint VBA without using .Select method

Question

I am writing a code that creates a PowerPoint from Excel VBA, using data from the Excel document. In this document, i have a Sheet called IMG where there is a series of images named "Picture X", X being the number of the current picture. The code I have for copying these pictures and pasting them on their respective PowerPoint Slide uses the .Select method, which, according to what I have read around here, makes the code run slower, and can/must be avoidable. I want to know if it is possible to avoid using the ".Select" method and still be able to paste the images from the excel sheet.

The code I am using is:

Dim pptSlide As PowerPoint.Slide

Sheets("IMG").Select
    ActiveSheet.Shapes.Range(Array("Picture 1")).Select
    Selection.Copy

pptSlide.Shapes.PasteSpecial(ppPasteMetafilePicture).Select
pptSlide.Shapes(4).Width = 121
pptSlide.Shapes(4).Height = 51
pptSlide.Shapes(4).Left = 580
pptSlide.Shapes(4).Top = 3

Thanks

Rest of my code:

Dim pptApp As PowerPoint.Application
Dim pptPres As PowerPoint.Presentation
Dim pptSlide As PowerPoint.Slide
Dim pptShape As PowerPoint.Shape
Dim excelTable As Excel.Range
Dim SlideTitle As String
Dim SlideText As String
Dim SlideObject As Object
Dim pptTextbox As PowerPoint.Shape
Dim SlideNumber As String
Dim myPic As Object



On Error Resume Next
Set pptApp = New PowerPoint.Application


Set pptPres = pptApp.Presentations.Add
pptPres.PageSetup.SlideSize = ppSlideSizeOnScreen
pptPres.ApplyTemplate "c:Program FilesMicrosoft OfficeTemplates1033Blank.potx"

pptPres.PageSetup.FirstSlideNumber = 0

''Consolidados
Set excelTable1 = Worksheets("TDCSD").Range("N280:U287")
Set excelTable2 = Worksheets("TDEXITO").Range("N48:U55")
Set excelTable3 = Worksheets("TDGPA").Range("N81:U88")
Set excelTable4 = Worksheets("TDSACI").Range("N234:U241")
Set excelTable5 = Worksheets("TDSMU").Range("N47:U54")
Set excelTable6 = Worksheets("TDRPLY").Range("N76:U83")
Set excelTable7 = Worksheets("TDInR").Range("N44:U51")
Set excelTable8 = Worksheets("TDPA").Range("N59:U66")
Set excelTable9 = Worksheets("TDIRSA").Range("N31:U38")
Set excelTable10 = Worksheets("TCOM").Range("Q8:AC17")
Set excelTable11 = Worksheets("TCOM").Range("Q24:AC33")


'SLIDES

'Slide 0

Set pptSlide = pptPres.Slides.Add(1, ppLayoutTitle)

SlideTitle = ThisWorkbook.Sheets("PPT").Range("F7").Value
pptSlide.Shapes(1).TextFrame.TextRange.Text = SlideTitle

pptSlide.Shapes.Title.TextFrame.TextRange.Characters(Start:=36, Length:=65).Font.Size = 20
pptSlide.Shapes.Title.Width = 610

pptSlide.Shapes(2).TextFrame.TextRange.Text = ThisWorkbook.Sheets("PPT").Range("B7").Value

'Agregar el número de diapositiva en la esquina derecha:
Set pptTextbox = pptSlide.Shapes.AddTextbox( _
    msoTextOrientationHorizontal, 686, 510, 34, 29)

With pptTextbox.TextFrame
    .TextRange.InsertSlideNumber
    .TextRange.Font.Size = 8
    .TextRange.Font.Name = "Tahoma"
    .TextRange.Font.Color = RGB(137, 137, 137)
    .VerticalAnchor = msoAnchorMiddle
End With



'Slide 1:

Set pptSlide = pptPres.Slides.Add(2, ppLayoutCustom)
SlideTitle = "Introducción"
pptSlide.Shapes.Title.TextFrame.TextRange.Text = SlideTitle
pptSlide.Shapes.Title.TextFrame.TextRange.Font.Size = 22


Set pptTextbox = pptSlide.Shapes(1)

pptTextbox.TextFrame.TextRange.Text = ThisWorkbook.Sheets("PPT").Range("B11").Value
pptTextbox.Top = 88
pptTextbox.TextFrame.TextRange.Paragraphs.ParagraphFormat.Alignment = ppAlignJustify

'Agregar el número de diapositiva:
Set pptTextbox = pptSlide.Shapes.AddTextbox( _
    msoTextOrientationHorizontal, 686, 510, 34, 29)

With pptTextbox.TextFrame
    .TextRange.InsertSlideNumber
    .TextRange.Font.Size = 8
    .TextRange.Font.Name = "Tahoma"
    .TextRange.Font.Color = RGB(137, 137, 137)
    .VerticalAnchor = msoAnchorMiddle
End With




'Slide 2:
Set pptSlide = pptPres.Slides.Add(3, ppLayoutTitleOnly)
SlideTitle = "Agenda"
pptSlide.Shapes.Title.TextFrame.TextRange.Text = SlideTitle
pptSlide.Shapes.Title.TextFrame.TextRange.Font.Size = 22

Set pptTextbox = pptSlide.Shapes.AddTextbox( _
    msoTextOrientationHorizontal, 686, 510, 34, 29)

With pptTextbox.TextFrame
    .TextRange.InsertSlideNumber
    .TextRange.Font.Size = 8
    .TextRange.Font.Name = "Tahoma"
    .TextRange.Font.Color = RGB(137, 137, 137)
    .VerticalAnchor = msoAnchorMiddle
End With


'Slide 3:
''Crear Slide y a?adir título
Set pptSlide = pptPres.Slides.Add(4, ppLayoutCustom)
SlideTitle = "Noticias Relevantes"
pptSlide.Shapes.Title.TextFrame.TextRange.Text = SlideTitle
pptSlide.Shapes.Title.TextFrame.TextRange.Font.Size = 22

''Insertar el texto desde Excel
Set pptTextbox = pptSlide.Shapes(1)

pptTextbox.TextFrame.TextRange.Text = ThisWorkbook.Sheets("PPT").Range("B24").Value
pptTextbox.Top = 68.8
pptTextbox.TextFrame.TextRange.Paragraphs.ParagraphFormat.Alignment = ppAlignJustify

''A?adir número de Slide
Set pptTextbox = pptSlide.Shapes.AddTextbox( _
    msoTextOrientationHorizontal, 686, 510, 34, 29)

With pptTextbox.TextFrame
    .TextRange.InsertSlideNumber
    .TextRange.Font.Size = 8
    .TextRange.Font.Name = "Tahoma"
    .TextRange.Font.Color = RGB(137, 137, 137)
    .VerticalAnchor = msoAnchorMiddle
End With

'A?adir imagenes
'Falabella
Sheets("IMG").Shapes("Picture 1").Copy
pptSlide.Shapes.PasteSpecial(ppPasteMetafilePicture).Select
pptSlide.Shapes(4).Width = 121
pptSlide.Shapes(4).Height = 51
pptSlide.Shapes(4).Left = 579.4
pptSlide.Shapes(4).Top = 3.4


'Slide 4:
''Crear Slide y a?adir el título
Set pptSlide = pptPres.Slides.Add(5, ppLayoutCustom)
SlideTitle = "Noticias Relevantes"
pptSlide.Shapes.Title.TextFrame.TextRange.Text = SlideTitle
pptSlide.Shapes.Title.TextFrame.TextRange.Font.Size = 22

''A?adir texto
Set pptTextbox = pptSlide.Shapes(1)

pptTextbox.TextFrame.TextRange.Text = ThisWorkbook.Sheets("PPT").Range("B49").Value
pptTextbox.Top = 77
pptTextbox.TextFrame.TextRange.Paragraphs.ParagraphFormat.Alignment = ppAlignJustify

''A?adir número de Slide
Set pptTextbox = pptSlide.Shapes.AddTextbox( _
    msoTextOrientationHorizontal, 686, 510, 34, 29)

With pptTextbox.TextFrame
    .TextRange.InsertSlideNumber
    .TextRange.Font.Size = 8
    .TextRange.Font.Name = "Tahoma"
    .TextRange.Font.Color = RGB(137, 137, 137)
    .VerticalAnchor = msoAnchorMiddle
End With

''A?adir imagenes
'Grupo éxito
Sheets("IMG").Shapes("Picture 2").Copy

pptSlide.Shapes.PasteSpecial (ppPasteMetafilePicture)
pptSlide.Shapes(4).Width = 108
pptSlide.Shapes(4).Height = 65
pptSlide.Shapes(4).Left = 592
pptSlide.Shapes(4).Top = 1.42

Answer 1

Good call on avoiding "selecting" the object. The only time I really ever select is when I am intentionally directing the user to a tab/cell.

So how about this:

Dim s As Shape
Dim ws As Worksheet

Set ws = ThisWorkbook.Worksheets("IMG")
Set s = ws.Shapes("Picture 1")

s.Copy

And of course you could loop through each shape on the worksheet:

for each s in ws.shapes
  debug.print s.name
  s.copy
  'Code for pasting the image
next s

Good luck! Hope it helps!