![]() |
#1
|
|||
|
|||
![]()
Hi forum members..
A bit of a strange request that I'll hopefully try and explain as simply as possible -
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 |
#2
|
|||
|
|||
![]()
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)
|
#3
|
|||
|
|||
![]()
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. |
#4
|
|||
|
|||
![]()
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? |
#5
|
|||
|
|||
![]()
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. |
#6
|
|||
|
|||
![]()
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 |
![]() |
|
![]() |
||||
Thread | Thread Starter | Forum | Replies | Last Post |
![]() |
panel | PowerPoint | 1 | 08-16-2012 06:33 AM |
![]() |
yAnn1ck | Word VBA | 1 | 04-08-2012 10:28 PM |
![]() |
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 |