CODEWITHSUNDEEP
excelvbapowerpoint
Emma
Emma

Reputation: 562

VBA Save Multiple Powerpoint presentation slides as JPG

I have a folder full of PowerPoint presentations and wish to batch open each one and save each slide as an image. I have found some code that I am running as a macro in Excel to save as PDF - I can re-save as PDF but how do I modify this to include saving the slides as jpeg images ?

Option Explicit
Dim oPPTApp As PowerPoint.Application
Dim oPPTFile As PowerPoint.Presentation
Sub Converter()
Dim cnt As Integer, currfile As String
Dim TrimFile As String, Path As String, FilesInPath As String _
, MyFiles() As String, Fnum As Long
Dim CalcMode As Long, LPosition As Long
Dim StartTime As Date, EndTime As Date

     
ThisWorkbook.Activate
currfile = ActiveWorkbook.Name
         
Windows(currfile).Activate
Sheets("Sheet1").Activate
   
StartTime = Timer
Path = Range("C3").Text & "\"

FilesInPath = Dir(Path & "*.pp*")
If FilesInPath = "" Then
MsgBox "No files found"
Exit Sub
End If

Fnum = 0
Do While FilesInPath <> ""
Fnum = Fnum + 1
ReDim Preserve MyFiles(1 To Fnum)
MyFiles(Fnum) = FilesInPath
FilesInPath = Dir()
Loop

With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
.EnableEvents = False
End With

If Fnum > 0 Then
For Fnum = LBound(MyFiles) To UBound(MyFiles)
  Set oPPTApp = CreateObject("PowerPoint.Application")
    oPPTApp.Visible = msoTrue
     
    On Error Resume Next
   
Set oPPTFile = oPPTApp.Presentations.Open(Path & MyFiles(Fnum))


   
   
On Error GoTo 0

If Not oPPTFile Is Nothing Then


LPosition = InStr(1, oPPTFile.Name, ".") - 1
TrimFile = Left(oPPTFile.Name, LPosition)


//here trying to save the slides as images
myslide = oPPTFile.Slides(1).Select
myslide.Export oPPTFile.Path & "\" & TrimFile & ".pdf"




On Error Resume Next

oPPTFile.ExportAsFixedFormat oPPTFile.Path & "\" & TrimFile & ".pdf", _
ppFixedFormatTypePDF, ppFixedFormatIntentPrint


   
   End If
   
oPPTFile.Close
   
   Next Fnum
End If


With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = CalcMode
End With
 
    oPPTApp.Quit

    Set oPPTFile = Nothing
    Set oPPTApp = Nothing
   
EndTime = Timer
MsgBox " Task succesfully completed in " & Format(EndTime - StartTime, "0.00") & " seconds"
End Sub

Upvotes: 0

Views: 1923

Answers (1)

John Korchok
John Korchok

Reputation: 4923

You're almost there. Just add the FilterName argument after the path and file names. BTW, I doubt you need to select the slide in the previous line before exporting it.

myslide.Export oPPTFile.Path & "\" & TrimFile & ".jpg", "JPG"

Upvotes: 3

Related Questions