batch of ppts to jpg convert

  • Thread starter Thread starter deepaj87
  • Start date Start date
D

deepaj87

Hi,

I'm looking for a way to convert 100s of powerpoint presentations into
jpegs (as in make every slide a jpeg), without having to go through
and do it manually, which would take days!

Thanks for the help!
 
How are your VBA coding skills?

This can be done with code. Do you need help in writing the code? A great
place to start would be this FAQ page.

**Batch: Do something to every file in a folder
http://www.pptfaq.com/FAQ00536.htm


--
Bill Dilworth
A proud member of the Microsoft PPT MVP Team
Users helping fellow users.
http://billdilworth.mvps.org
-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_
vestprog2@ Please read the PowerPoint FAQ pages.
yahoo. They answer most of our questions.
com www.pptfaq.com
..
 
What Bill said.

And also

Export slides as graphicshttp://www.pptfaq.com/FAQ00022.htm

-----------------------------------------
Steve Rindsberg, PPT MVP
PPT FAQ: www.pptfaq.com
PPTools: www.pptools.com
================================================

Thanks so much for that! I'm still not able to get it to work though!
It will extract Slide1 of the Active Presentation and then stop. Here
is what I have:

Sub ForEachPresentation()
' Run a macro of your choosing on each presentation in a folder

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

' EDIT THESE to suit your situation
FolderPath = "Z:\Projects\2007\Microsoft\EETWC\Post Production\PPTX
\eetwcforum_07_29_07\Cascade\Fri - June 29\Moved to Podium\" ' Note:
MUST end in \
FileSpec = "*.pptx"
' END OF EDITS

' Fill the array with files that meet the spec above
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) As
String
strTemp = Dir
Wend

' array has one blank element at end - don't process it
' don't do anything if there's less than one element
If UBound(rayFileList) > 1 Then
For x = 1 To UBound(rayFileList) - 1
Call MyMacro(rayFileList(x))
Next x
End If

End Sub

And then in another module:

Sub MyMacro(strMyFile As String)

Dim ExportPath As String ' drive:\path to export to
Dim Pixwidth As Integer ' size in pixels of exported image
Dim Pixheight As Integer
Dim oSlide As Slide

' Edit to suit
Pixwidth = 1024

' Set height proportional to slide height
Pixheight = (Pixwidth *
ActivePresentation.PageSetup.SlideHeight) /
ActivePresentation.PageSetup.SlideWidth

ExportPath = ActivePresentation.Path & "\"

Set oSlide = ActiveWindow.View.Slide
With oSlide
.Export ExportPath & "Slide" & CStr(.SlideIndex) & ".JPG",
"JPG", Pixwidth, Pixheight
End With

End Sub

I debugged it and there was nothing wrong with it. What am I doing
wrong ?

Thank you!
 
Thanks so much for that! I'm still not able to get it to work though!
It will extract Slide1 of the Active Presentation and then stop. Here
is what I have:

The subroutine that does the export is doing exactly what it's supposed to do.
You need to modify it to do what you WANT it to do. ;-)
See comments below:
Sub ForEachPresentation()
' Run a macro of your choosing on each presentation in a folder

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

' EDIT THESE to suit your situation
FolderPath = "Z:\Projects\2007\Microsoft\EETWC\Post Production\PPTX
\eetwcforum_07_29_07\Cascade\Fri - June 29\Moved to Podium\" ' Note:
MUST end in \
FileSpec = "*.pptx"
' END OF EDITS

' Fill the array with files that meet the spec above
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) As
String
strTemp = Dir
Wend

' array has one blank element at end - don't process it
' don't do anything if there's less than one element
If UBound(rayFileList) > 1 Then
For x = 1 To UBound(rayFileList) - 1
Call MyMacro(rayFileList(x))
Next x
End If

End Sub

And then in another module:

Sub MyMacro(strMyFile As String)

Dim ExportPath As String ' drive:\path to export to
Dim Pixwidth As Integer ' size in pixels of exported image
Dim Pixheight As Integer
Dim oSlide As Slide

' Edit to suit
Pixwidth = 1024

Dim oPres as Presentation

' Open the presentation passed to the subroutine so IT is the
' active presentation
Set oPres = Presentations.Open(strMyFile)
' Set height proportional to slide height
Pixheight = (Pixwidth *
ActivePresentation.PageSetup.SlideHeight) /
ActivePresentation.PageSetup.SlideWidth

ExportPath = ActivePresentation.Path & "\"

' Delete this
' > Set oSlide = ActiveWindow.View.Slide

For each oSlide in oPres.Slides
With oSlide
.Export ExportPath & "Slide" & CStr(.SlideIndex) & ".JPG",
"JPG", Pixwidth, Pixheight
End With

Next ' oSlide
oPres.Close
 
Back
Top