![]() |
#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 |