vbapowerpoint

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