afbeeldingenimport uit powerpointpresentatie met shapes.selectall

[snb]

Hallo,

Ik wil alle afbeeldingen uit de onderstaande -ingepakte- powerpointpresentatie diagewijs in Excel kopiëren.
Het lukt in VBA alle afbeeldingen (shapes) in 1 dia (slide) te selecteren, maar de kopieeropdracht gebruikt deze selectie niet.
Wie heeft een lumineuze inval ?

Sub M_snb()
  For Each it In GetObject(, "Powerpoint.application").activepresentation.slides
     it.Shapes.SelectAll
     Selection.Copy                                   ' werkt niet 
     it.parent.parent.selection.copy             ' werkt ook niet
     it.application.selection.copy                 ' werkt evenmin

     Sheet1.Paste Sheet1.Cells(1) ' dus deze ook niet
  Next
End Sub

 

[JEC.]

ik denk dat je deze weg moet inslaan. Eerst opslaan als aparte bestanden en daarna teruglezen in Excel

Sub jec()
 Dim xfold, sl, shp
 xfold = "C:\Users\xxxx\Downloads\"
 
 For Each sl In GetObject(, "Powerpoint.application").ActivePresentation.Slides
    For Each shp In sl.Shapes
        If shp.Type = msoGroup Then shp.Export xfold & shp.Name & ".jpg", ppShapeFormatJPG
    Next shp
 Next sl
End Sub

 

[snb]

@JEC

Mijn vraag gaat over hoe te werken met shapes.selectall.
Als afzonderlijke afbeeldingen kan het eenvoudigweg met .copy (zie onder)

  For Each it In GetObject(, "Powerpoint.application").activepresentation.slides
    for each it1 in it.Shapes
     it1.copy
     Sheet1.Paste Sheet1.Cells(1)
    next
  Next

 

[snb]

Ter info:
Met shapes.selectall lukt het mij niet.
Met een alternatieve methode lukt het wél per dia.
Op deze manier bijlft de struktuur tussen de afbeeldingen intact.

Sub M_snb()
  For Each it In GetObject(, "Powerpoint.application").presentations(1).slides
     it.Shapes.Range.Copy
     If Sheet1.Shapes.Count = 0 Then
         Sheet1.Paste Sheet1.Cells(1)
     Else
        Sheet1.Paste Sheet1.Cells(Sheet1.Shapes(Sheet1.Shapes.Count).BottomRightCell.Offset(1).Row, 1)
     End If
  Next
End Sub

 

[E v R]

Sub M_snb()
  For Each it In GetObject(, "Powerpoint.application").activepresentation.slides
     it.Select
     it.Shapes.SelectAll
     it.Application.ActiveWindow.Selection.Copy
     If Sheet1.Shapes.Count = 0 Then
         Sheet1.Paste Sheet1.Cells(1)
     Else
        Sheet1.Paste Sheet1.Cells(Sheet1.Shapes(Sheet1.Shapes.Count).BottomRightCell.Offset(1).Row, 1)
     End If
  Next
End Sub

 

[snb]

@EvR

Hartelijk dank !!
Slim hoor.
Ik dacht altijd dat 'selection' een object van de applicatie was (zie de object Browser).
Blijkt dat ook van een window te zijn.
Uit het feit dat de dia geselecteerd moet zijn om de afbeeldingen te kunnen selecteren leid ik af dat het Object-geOriënteerde karakter van Powerpoint wat minder geïmplementeerd is dan in Excel en Word.