Powerpoint Macro to save (export) individual images to files - 'cept... doesn't work!

  • Thread starter Thread starter ferdberfel
  • Start date Start date
F

ferdberfel

hello,

I'm trying to write a macro to take the images in a powerpoint
presentation and save them to a separate folder. I recorded a macro
to see how it's done and I got this:

Sub Macro3()
ActiveWindow.Selection.SlideRange.Shapes("Picture 16").Select
ActivePresentation.SaveAs FileName:="C:\Documents and Settings
\username\My Documents\My Pictures\Picture1.jpg",
FileFormat:=ppSaveAsJPG, EmbedTrueTypeFonts:=msoFalse
End Sub


works great. just like I expected - I selected an image - right
clicked, picked "Save as Picture" . excellent.

so then I wanted to loop through all slides, and loop through all
shapes on each slide.... if it's an image, save it. However what
happens is for every single slide, the "ActivePresentation.SaveAs" ...
saves EVERY single SLIDE as a jpeg... and I don't even have the
selected image as a separate entity, just the whole slide... here's
that code:


any ideas would be greatly appreciated! Thanks in advance!

(Powerpoint 2003) (Windows XP 5.1 SP3)

Sub ExportAllImages()
Dim thePresentation As Presentation
Dim theSlides As Slides
Dim curSlide As Slide
Dim curShape As Shape
Dim CurrentPageName As String
Dim CurrentPageNumber As Integer
Dim CurrentFileIndex As Integer
On Error GoTo ErrorHandler

Set thePresentation = ActivePresentation
Set theSlides = thePresentation.Slides


CurrentPageNumber = 0
For Each curSlide In theSlides 'get every single slide
CurrentPageNumber = CurrentPageNumber + 1

' go to each slide
For Each curShape In curSlide.Shapes ' inspect every shape
CurrentFileIndex = 1
If curShape.Type = 13 Then
'curShape.Select

ActiveWindow.Selection.SlideRange.Shapes(curShape.Name).Select
MsgBox "did I select the Picture [" & curShape.Name &
"] ?"
fname = thePresentation.Path & "\" & "stuff\Page" &
CurrentPageNumber & "_" & CurrentFileIndex & ".jpg"
Debug.Print "Please wait ….. saving [" & fname & "]"
ActivePresentation.SaveAs FileName:=fname,
FileFormat:=ppSaveAsJPG, EmbedTrueTypeFonts:=msoFalse
CurrentFileIndex = CurrentFileIndex + 1
Debug.Print "back from saving image"

End If
Debug.Print "Please wait getting next shape"
Next curShape
'Exit Sub '---- uncomment this to just let it operate on 1
slide, otherwise it will seemingly go away for ever while it tries to
save ALL slides, everytime.
Next curSlide


MsgBox "Done! "
Exit Sub
ErrorHandler:
MsgBox "oops: error : " & Err.Description & " curShape.Name = " &
curShape.Name
End Sub
 
ferdberfel said:
' go to each slide
For Each curShape In curSlide.Shapes ' inspect every shape
CurrentFileIndex = 1
If curShape.Type = 13 Then
'curShape.Select
Click to expand...

You have this statement commented, so nothing is selected but the slide...
 
Thanks for your response -

I commented the line

'curShape.select

because that one didn't work - instead I went with the line that was
created when I recorded the macro


ActiveWindow.Selection.SlideRange.Shapes(curShape.Name).Select

(where it says "curShape.Name" the macro said "Picture 11" - so I just
variablized (sp?) the shape name )

in either case tho, every time it comes to a page, it creates a folder
with 118 images, each one a full slide, and not just "curShape".

any ideas?

Tia
 
Thanks for your response -

I commented the line

'curShape.select

because that one didn't work - instead I went with the line that was
created when I recorded the macro


ActiveWindow.Selection.SlideRange.Shapes(curShape.Name).Select

(where it says "curShape.Name" the macro said "Picture 11" - so I just
variablized (sp?) the shape name )

in either case tho, every time it comes to a page, it creates a folder
with 118 images, each one a full slide, and not just "curShape".

any ideas?

Tia
 
I apologize for responding to myself but- i noticed this confusion:

when I record a macro - I select an image, right click on it, choose
"save as picture":

Sub Macro3()
ActiveWindow.Selection.SlideRange.Shapes("Picture 16").Select
ActivePresentation.SaveAs FileName:="C:\Documents and Settings
\username\My Documents\My Pictures\Picture1.jpg",
FileFormat:=ppSaveAsJPG, EmbedTrueTypeFonts:=msoFalse
End Sub

and it works great. "ActivePresentation.SaveAs" save just 1 image.

however, in the larger macro, when looping the line

ActivePresentation.SaveAs FileName:=fname,FileFormat:=ppSaveAsJPG,
EmbedTrueTypeFonts:=msoFalse

I create a filename (fname) in the fomat "page_x_y.jpg" ... but
that's not what happens - I get a FOLDER called page_x_y, and inside
there are 100+ files called SlideX.jpg (Slide1, Slide2 ...etc) - so
the ActivePresentation.SaveAs is working differently

and I know that I've selected the image because the line that says
MsgBox "Did I select the Image?"
shows that it's selected.

so... here "ActivePresentation.SaveAs" saves the entire ... active
presentation...

confused.
again,
TIA
 
I apologize for responding to myself but- i noticed this confusion:

when I record a macro - I select an image, right click on it, choose
"save as picture":

Sub Macro3()
ActiveWindow.Selection.SlideRange.Shapes("Picture 16").Select
ActivePresentation.SaveAs FileName:="C:\Documents and Settings
\username\My Documents\My Pictures\Picture1.jpg",
FileFormat:=ppSaveAsJPG, EmbedTrueTypeFonts:=msoFalse
End Sub

and it works great. "ActivePresentation.SaveAs" save just 1 image.

however, in the larger macro, when looping the line

ActivePresentation.SaveAs FileName:=fname,FileFormat:=ppSaveAsJPG,
EmbedTrueTypeFonts:=msoFalse

I create a filename (fname) in the fomat "page_x_y.jpg" ... but
that's not what happens - I get a FOLDER called page_x_y, and inside
there are 100+ files called SlideX.jpg (Slide1, Slide2 ...etc) - so
the ActivePresentation.SaveAs is working differently

and I know that I've selected the image because the line that says
MsgBox "Did I select the Image?"
shows that it's selected.

so... here "ActivePresentation.SaveAs" saves the entire ... active
presentation...

confused.
again,
TIA
 
Matt's thought was a good one, but it is not the problem here. The macro
recorder is imperfect (to be kind and gentle about it). the SaveAs
method will only save slides, not shapes. What you want is the Export
method. You have the shape you want as the variable curShape and the
name of the file you want as fname so all you need to do is:

curShape.Export fname, ppShapeFormatJPG

Don't bother with selecting the shape at all.

--David

hello,

I'm trying to write a macro to take the images in a powerpoint
presentation and save them to a separate folder. I recorded a macro
to see how it's done and I got this:

Sub Macro3()
ActiveWindow.Selection.SlideRange.Shapes("Picture 16").Select
ActivePresentation.SaveAs FileName:="C:\Documents and Settings
\username\My Documents\My Pictures\Picture1.jpg",
FileFormat:=ppSaveAsJPG, EmbedTrueTypeFonts:=msoFalse
End Sub


works great. just like I expected - I selected an image - right
clicked, picked "Save as Picture" . excellent.

so then I wanted to loop through all slides, and loop through all
shapes on each slide.... if it's an image, save it. However what
happens is for every single slide, the "ActivePresentation.SaveAs" ...
saves EVERY single SLIDE as a jpeg... and I don't even have the
selected image as a separate entity, just the whole slide... here's
that code:


any ideas would be greatly appreciated! Thanks in advance!

(Powerpoint 2003) (Windows XP 5.1 SP3)

Sub ExportAllImages()
Dim thePresentation As Presentation
Dim theSlides As Slides
Dim curSlide As Slide
Dim curShape As Shape
Dim CurrentPageName As String
Dim CurrentPageNumber As Integer
Dim CurrentFileIndex As Integer
On Error GoTo ErrorHandler

Set thePresentation = ActivePresentation
Set theSlides = thePresentation.Slides


CurrentPageNumber = 0
For Each curSlide In theSlides 'get every single slide
CurrentPageNumber = CurrentPageNumber + 1

' go to each slide
For Each curShape In curSlide.Shapes ' inspect every shape
CurrentFileIndex = 1
If curShape.Type = 13 Then
'curShape.Select

ActiveWindow.Selection.SlideRange.Shapes(curShape.Name).Select
MsgBox "did I select the Picture ["& curShape.Name&
"] ?"
fname = thePresentation.Path& "\"& "stuff\Page"&
CurrentPageNumber& "_"& CurrentFileIndex& ".jpg"
Debug.Print "Please wait ….. saving ["& fname& "]"
ActivePresentation.SaveAs FileName:=fname,
FileFormat:=ppSaveAsJPG, EmbedTrueTypeFonts:=msoFalse
CurrentFileIndex = CurrentFileIndex + 1
Debug.Print "back from saving image"

End If
Debug.Print "Please wait getting next shape"
Next curShape
'Exit Sub '---- uncomment this to just let it operate on 1
slide, otherwise it will seemingly go away for ever while it tries to
save ALL slides, everytime.
Next curSlide


MsgBox "Done! "
Exit Sub
ErrorHandler:
MsgBox "oops: error : "& Err.Description& " curShape.Name = "&
curShape.Name
End Sub
Click to expand...


--
David M. Marcovitz
Author of _Powerful PowerPoint for Educators_
http://www.PowerfulPowerPoint.com/
Microsoft PowerPoint MVP
Associate Professor, Loyola University Maryland
 
Thank you so much! that's it!

(apologize for hitting "form resend" - hence resending my posts...
DOH!)
 
Back
Top