VBA将多个Powerpoint演示文稿幻灯片另存为JPG

时间:2019-10-02 15:33:51

标签: excel vba powerpoint

我有一个充满PowerPoint演示文稿的文件夹,希望批量打开每个演示文稿并将每张幻灯片另存为图像。我已经找到一些在Excel中作为宏运行并保存为PDF的代码-我可以重新另存为PDF,但是如何修改它以将幻灯片另存为jpeg图像?

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

1 个答案:

答案 0 :(得分:3)

您快到了。只需在路径和文件名之后添加FilterName参数即可。顺便说一句,我怀疑您需要在导出幻灯片之前选择上一行。

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