Hi forum members..



A bit of a strange request that I'll hopefully try and explain as simply as possible -

• I've a large number of .ppt files, one each for a group of employees.
• In each file is a .jpg image of employee.
• I need to save the image only as a .jpg in another folder, but also rename it using the same file name as the .ppt file it came from.

The files are all named using the employee number, hence the .jpg needs to be the same so it can be identified.

I'm posting on here in the hope that someone can help and save me having to manually save and rename hundreds of image files!

Many thanks, any help gratefully received.

J

Probably could be done but there would need to be a way to identify the correct image to extract (What slide it's on. a common name etc)

__________________
Microsoft PowerPoint MVP 2007-2023
Free Advanced PowerPoint Tips and Tutorials

Thanks for replying so quickly John.

There's only one .jpg in the file, which I also omitted to mention the file is only one slide. Everything else on there is a text box, except one .png image.

The code won't be able to distinguish between PNG and JPG

Are either contained in a placeholder?
Wich would be "further back" if they overlapped?

__________________
Microsoft PowerPoint MVP 2007-2023
Free Advanced PowerPoint Tips and Tutorials

Thanks again for replying.

By the looks of it, yes they are in both in placeholders. The image I want to save looks to me like it is behind the PNG.

Try this then
Create two folders on the deskto 'PICIN' and 'Pics'

Put a couple of the presentations in PICIN and run this macro

Sub getImagesfromFolder()
Dim rayFileList() As String
Dim FolderPath As String
Dim FileSpec
Dim strTemp As String
Dim x As Long

FolderPath = Environ("USERPROFILE") & "\Desktop\PICIN\" ' Folder with presentations MUST end in \
FileSpec = "*.pp*"


ReDim rayFileList(1 To 1) As String
strTemp = Dir$(FolderPath & FileSpec)
While strTemp <> ""
rayFileList(UBound(rayFileList)) = FolderPath & strTemp
ReDim Preserve rayFileList(1 To UBound(rayFileList) + 1)
strTemp = Dir
Wend
ReDim Preserve rayFileList(1 To UBound(rayFileList) - 1) 'kill top blank value
If UBound(rayFileList) > 1 Then
For x = 1 To UBound(rayFileList)
Call Exporter(rayFileList(x))
Next x
End If
End Sub

Sub Exporter(strMyFile As String)
Dim opic As Shape
Dim osld As Slide
Dim oPres As Presentation
Set oPres = Presentations.Open(strMyFile)
Set osld = oPres.Slides(1)
For Each opic In osld.Shapes
If opic.Type = msoPicture Then Exit For
If opic.Type = msoPlaceholder Then
If opic.PlaceholderFormat.ContainedType = msoPicture Then Exit For
End If
Next opic
' Make a folder called Pics on the desktop first
Call opic.Export(Environ("USERPROFILE") & "\Desktop\Pics\" & stripSuffix(oPres.Name) & ".jpg", _
ppShapeFormatJPG, oPres.PageSetup.SlideWidth, oPres.PageSetup.SlideHeight)
oPres.Saved = True
oPres.Close
End Sub

Function stripSuffix(strname As String) As String
Dim ipos As Integer
ipos = InStrRev(strname, ".")
stripSuffix = Left(strname, ipos - 1)
End Function


With any luck the images will end up in the Pics folder

__________________
Microsoft PowerPoint MVP 2007-2023
Free Advanced PowerPoint Tips and Tutorials