Microsoft Office Forums

Go Back   Microsoft Office Forums > >

Reply
 
Thread Tools Display Modes
  #1  
Old 07-15-2013, 06:24 AM
jammer jammer is offline Image Renaming Macro? Windows 7 32bit Image Renaming Macro? Office 2010 32bit
Novice
Image Renaming Macro?
 
Join Date: Jul 2013
Posts: 3
jammer is on a distinguished road
Default Image Renaming Macro?

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
Reply With Quote
  #2  
Old 07-15-2013, 06:58 AM
JohnWilson JohnWilson is offline Image Renaming Macro? Windows 7 64bit Image Renaming Macro? Office 2010 32bit
Programmer
 
Join Date: Nov 2008
Location: UK
Posts: 1,912
JohnWilson has a spectacular aura aboutJohnWilson has a spectacular aura about
Default

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
Reply With Quote
  #3  
Old 07-15-2013, 07:02 AM
jammer jammer is offline Image Renaming Macro? Windows 7 32bit Image Renaming Macro? Office 2010 32bit
Novice
Image Renaming Macro?
 
Join Date: Jul 2013
Posts: 3
jammer is on a distinguished road
Default

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.
Reply With Quote
  #4  
Old 07-15-2013, 08:27 AM
JohnWilson JohnWilson is offline Image Renaming Macro? Windows 7 64bit Image Renaming Macro? Office 2010 32bit
Programmer
 
Join Date: Nov 2008
Location: UK
Posts: 1,912
JohnWilson has a spectacular aura aboutJohnWilson has a spectacular aura about
Default

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
Reply With Quote
  #5  
Old 07-15-2013, 09:14 AM
jammer jammer is offline Image Renaming Macro? Windows 7 32bit Image Renaming Macro? Office 2010 32bit
Novice
Image Renaming Macro?
 
Join Date: Jul 2013
Posts: 3
jammer is on a distinguished road
Default

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.
Reply With Quote
  #6  
Old 07-15-2013, 09:21 AM
JohnWilson JohnWilson is offline Image Renaming Macro? Windows 7 64bit Image Renaming Macro? Office 2010 32bit
Programmer
 
Join Date: Nov 2008
Location: UK
Posts: 1,912
JohnWilson has a spectacular aura aboutJohnWilson has a spectacular aura about
Default

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
Reply With Quote
Reply

Thread Tools
Display Modes


Similar Threads
Thread Thread Starter Forum Replies Last Post
Image Renaming Macro? Image page numbering macro panel PowerPoint 1 08-16-2012 06:33 AM
Image Renaming Macro? Stretch image to fullpage macro yAnn1ck Word VBA 1 04-08-2012 10:28 PM
Image Renaming Macro? Macro fails to add image border in Word 2007 samhdc Word 1 03-30-2012 04:56 AM
Renaming slide titles ragzdaddy PowerPoint 0 12-26-2011 01:18 PM
URGENT!!! Powerpoint Image Formatting and Positioning Macro mertulufi PowerPoint 5 12-20-2011 10:14 AM

Other Forums: Access Forums

All times are GMT -7. The time now is 04:16 AM.


Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2024, vBulletin Solutions Inc.
Search Engine Optimisation provided by DragonByte SEO (Lite) - vBulletin Mods & Addons Copyright © 2024 DragonByte Technologies Ltd.
MSOfficeForums.com is not affiliated with Microsoft