Excel VBA to save PPT shapes as PNG images

[Robert Goddard]

I have an Excel (.xlsm) that opens an existing PPT and uses VBA to modify several slides.
There are several shapes on each slide and my .xlsm has VBA that modifies those shapes.
(The slides have designs on them for different size business cards which get filled in with spreadsheet names,...)

Now I want to "select all" the shapes on a slide as a "group"(not sure that term is correct).
Then I want to export that group as a .PNG image file.
Save location can be the same folder location of the .xlsm file (doesn't really matter).

This is different than exporting each slide as a .PNG.(which I can already do).
In this case the business card designs on each slide are different sizes.
So I need the images to be just the size of the "group" on that slide.

The VBA code is within the .xlsm file (not the PPT)
Several posts show VBA code for within the .pptm file that works fine if using just a PPT
However that code doesn't seem to work when I put it in the .xlsm file to drive
the image creation from Excel.

======================

PC with latest of all software.

Pulling my hair out on this one.
Can anyone help.

 

[mjbeam]

Can you post the PPT code that will do what you are talking about?

 

[Robert Goddard]

+++++++++++++++++++++++++++
CODE SAMPLES
+++++++++++++++++++++++++++
'This .xlsm code prints slide 3 as a png.
Dim OPP As PowerPoint.Presentation
Set OPP = oPA.Presentations.Open(TemplateSelected)
OPP.Slides(3).Export filename:=Save_FullName, filtername:="PNG"


+++++++++++++++++++++++++++
'This .pptm code prints the shapes on each slide of a .pptm as a png.
'This is the code I wish would work from within the .xlsm file.

Sub PrintShapesToPng()
Dim ap As Presentation: Set ap = ActivePresentation
Dim sl As Slide
Dim shGroup As ShapeRange
For Each sl In ap.Slides
ActiveWindow.View.GotoSlide (sl.SlideIndex)
sl.Shapes.SelectAll
Set shGroup = ActiveWindow.Selection.ShapeRange
shGroup.Export ap.Path & "\Slide" & sl.SlideIndex & ".png", _
ppShapeFormatPNG, , , ppRelativeToSlide
Next
End Sub
+++++++++++++++++++++++++++

 

[mjbeam]

Sub PrintShapesToPng()

    Set ppt = CreateObject("Powerpoint.Application")
    Set ap = ppt.ActivePresentation
    
    For Each sl In ap.Slides
       ppt.ActiveWindow.View.GotoSlide (sl.SlideIndex)
       sl.Shapes.SelectAll
       Set shGroup = ppt.ActiveWindow.Selection.ShapeRange
       shGroup.Export ap.Path & "\Slide" & sl.SlideIndex & ".png", 2, , , 1
    Next
 
End Sub

 

[Robert Goddard]

It errors on:

Set shGroup = ppt.ActiveWindow.Selection.ShapeRange

Run-time error '13'
Type mismatch

FYI: also tried adding a statement
Dim shGroup As ShapeRange
but that didn't work either.

Any thoughts on my error.

 

[mjbeam]

Is the PPT already open when you run this macro? If not we need to add some code to open it. I tested it on an already open PPT.

 

[Robert Goddard]

Sometimes you look at code so long you don't see the obvious.
You pointed out my error.
Was able to fix it and now everything is running very well.

Thank you for your expertise in getting me on track.

 

[mjbeam]

Cool. Glad you got it working.