我有一个充满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
答案 0 :(得分:3)
您快到了。只需在路径和文件名之后添加FilterName参数即可。顺便说一句,我怀疑您需要在导出幻灯片之前选择上一行。
myslide.Export oPPTFile.Path & "\" & TrimFile & ".jpg", "JPG"