[SOLVED] export an image from Powerpoint

export an image from Powerpoint

I have a VBA script which needs to save embedded images from the selected powerpoint as .png files onto disk. I am able to save an entire slide, but that's not practical

I have found a couple of VBA solutions which require creation of an embedded Excel chart (eg this answer), using clipboard to copy and paste the image there and then save the chart but it seems clumsy and I would prefer not to impact the users clipboard (though if that's what it's going to take, then I'll have to take that approach)

Solution

One approach is to create a new presentation whose slide size is proportional to the size of the image you want to export, copy/paste the image to the new presentation, then export the slide from it.

You might also want to experiment with the (hidden) .Export method of the shape that represents the image you want to export. Getting the sizing right can be something of a challenge, but I think someone's worked it out and posted on SO.

Sub ExportPicture(sld As Slide, picture As Shape, filename As String, fileFormat As String)

Dim oPP As Object
Dim oPPT As Object
Dim oPPTslide As Object
Dim oSlide As Slide
Dim newSlide As Slide
Dim pptLayout As CustomLayout

' Copy the layout from the slide provided
Set pptLayout = sld.CustomLayout

Set oPP = CreateObject("PowerPoint.Application")
oPP.Visible = True

Set oPPT = oPP.Presentations.Add
oPPT.PageSetup.SlideSize = ppSlideSizeA4Paper
With ActivePresentation.PageSetup
    .SlideSize = ppSlideSizeCustom
    
    .SlideHeight = picture.Height
    .SlideWidth = picture.Width
    
    .FirstSlideNumber = 1
    If picture.Height > picture.Width Then
        .SlideOrientation = msoOrientationVertical
    Else
        .SlideOrientation = msoOrientationHorizontal
    End If
    
    .NotesOrientation = msoOrientationVertical
End With

' Add a slide
Set newSlide = ActivePresentation.Slides.Add(1, ppLayoutBlank)
   
' Add the picture to the new slide
picture.Copy
newSlide.Shapes.Paste

newSlide.Shapes(1).Left = 0

' Export the new slide
newSlide.Export filename & "." & LCase(fileFormat), UCase(fileFormat)
ActivePresentation.Close

End Sub