PDA

View Full Version : save as jpg



balumail75
12-21-2010, 05:52 AM
Hi all,

I tried for saving ppt files as jpg with the below code, by looping through a folder. It creates folders and saving it as Slide1.jpg in each folder. Please help me to save as with the same name.jpg.

Below is the code:

Sub Tojpg()
Dim oApp As Object
Dim ofolder
Dim rpath As String

Dim pptOpen As Presentation
Dim strExtension As String

Dim fname As String
Dim flname As String
Dim fpname As String
Dim fpathandname As String

Set oApp = CreateObject("Shell.Application")
'Browse to the folder
Set ofolder = oApp.BrowseForFolder(0, "Select folder", 512)
If ofolder Is Nothing Then
MsgBox "Good-bye! Better Try Next Time!"
Exit Sub
End If
rpath = ofolder.self.Path

On Error Resume Next

ChDir rpath

strExtension = Dir("*.pptx")

Do While strExtension <> ""
Set pptOpen = Presentations.Open(strExtension)

With pptOpen
fpname = ActivePresentation.Path & "\"
fname = ActivePresentation.Name
flname = Left(fname, 10) & ".jpg"
fpathandname = fpname & flname
'ActivePresentation.SaveAs FileName:=fname, FileFormat:=ppSaveAsJPG
ActivePresentation.SaveAs FileName:=fpathname, FileFormat:=ppSaveAsJPG, EmbedTrueTypeFonts:=msoTrue

'ActivePresentation.Slides(1).Export fpname & "\" & flname & ".jpg", "JPG"
Application.ActivePresentation.Close

End With

strExtension = Dir
Loop

On Error GoTo 0
End Sub

John Wilson
12-21-2010, 08:28 AM
Using the saveAs (JPG) method you cannot specify the file names. You can if you use the hidden method Export Slide as graphics

Benzadeus
12-25-2010, 10:54 AM
I might be missing something, but this snippet works for me:
Sub SaveSlidesAsJPG()

Dim n As Long

For n = 1 To ActivePresentation.Slides.Count
ActivePresentation.Slides(n).Export _
FileName:=ActivePresentation.Path & "\Slide" & n & ".jpg" _
, FilterName:="JPG"
Next n
End Sub

John Wilson
12-27-2010, 05:40 AM
No, that's correct. You may have to enable "hidden methods" to make it work.