尝试打开 ppt 文件时出错以及其他一些疑问 (powerpoint)
Error trying to open ppt file & a couple of other doubts (powerpoint)
我正在尝试编写一个子程序，将 Powerpoint 文件的各个幻灯片保存在用户 select 目录中，并将它们保存在另一个用户 selected 目录中。
源和目标对话框似乎工作正常，但我得到 'Method' 打开对象 'Presentation'。我解决不了。
另外，如果我想在循环中同时处理ppt和pptx时间文件，我应该做哪些更改。
最后，需要做些什么才能使其递归处理 selected 文件夹和所有子文件夹。
我知道很多 提前购买谢谢。
胡安
这是代码
Sub ExportPPTSlidesToSingles()
''Application.DisplayAlerts = False
Dim oPptApp As PowerPoint.Application
'Initial directory path.
Dim IntialPath As String
Dim SourceDialogBox As FileDialog
Dim TargetDialogBox As FileDialog
Dim SourceFolder As String
Dim TargetFolder As String
Dim SourceFile As Presentation
Dim TempPresentation As Presentation
Dim PresentationToProcess As String
Dim counter As Long
Dim OpenPresentation As Presentation
Dim TargetFileName As String
Set oPptApp = CreateObject("PowerPoint.Application")
Set SourceDialogBox = oPptApp.FileDialog(msoFileDialogFolderPicker)
Set TargetDialogBox = oPptApp.FileDialog(msoFileDialogFolderPicker)
ActiveWindow.ViewType = ppViewNormal
IntialPath = "D:\_ infographics\temp\"
'Select source data folder
MsgBox ("Select a SOURCE folder where input Powerpoint files are located.")
Set SourceDialogBox = Application.FileDialog(msoFileDialogFolderPicker)
If SourceDialogBox.Show = -1 Then
SourceFolder = SourceDialogBox.SelectedItems(1)
End If
'Select target data folder
MsgBox ("Select a TARGET folder - where the individual files will be saved.")
If TargetDialogBox.Show = -1 Then
TargetFolder = TargetDialogBox.SelectedItems(1)
End If
If MsgBox("Depending on the number of visible slides to export and the size " & _
"of your presentation, this might take some time." & vbCrLf & vbCrLf & "Continue?", _
vbYesNo + vbQuestion, _
"Export " & counter & " Visible Slides to Presentations") = vbNo Then Exit Sub
'Loop through only pptx files in source folder
PresentationToProcess = Dir(SourceFolder & "\*.ppt*")
MsgBox PresentationToProcess
While PresentationToProcess <> ""
' Open source files
Set OpenPresentation = Presentations.Open(PresentationToProcess)
On Error GoTo errorhandler
' Make a temoprary copy
TempPresentation.SaveCopyAs (Environ("TEMP") & "\temppres.pptx")
On Error Resume Next
Set TempPresentation = Presentations.Open(FileName:=Environ("TEMP") & "\temppres.pptx", WithWindow:=False)
' Loop through slides
For counter = OpenPresentation.Slides.count To 1 Step -1
OpenPresentation.Slides(counter).Copy
TempPresentation.Slides.Paste
' Create a unique filename and save a copy of each slide
TargetFileName = Left(ActivePresentation.Name, InStrRev(ActivePresentation.Name, ".") - 1) & " [" & counter & "].pptx"
Call TempPresentation.SaveAs(FileName:=Environ("USERPROFILE") & "\Desktop\slides\" & TargetFileName & counter & ".pptx", EmbedTrueTypeFonts:=False)
TempPresentation.Slides(1).Delete
Next counter
TempPresentation.Close
OpenPresentation.Close
OpenPresentation = Dir
Wend
'Close the ppt
oPptApp.Presentations.Application.Quit
On Error GoTo 0
Exit Sub
errorhandler:
Debug.Print Err, Err.Description
Resume Next
End Sub
PresentationToProcess 只是文件名（Dir 不是 return 完整路径）所以你需要在调用 Open()[ 之前添加路径=16=]
Set OpenPresentation = Presentations.Open(SourceFolder & "\" & PresentationToProcess)
您的 Dir(SourceFolder & "\*.ppt*") 应该已经找到 .pptx 和 .ppt 文件类型。
这里有很多关于如何通过子文件夹递归搜索的以前的帖子 - 尝试从其中一个帖子中找到答案。
例如：Loop Through Sub-Dir
所以你遇到这个错误是因为代码没有使用它试图加载的源文件的完整路径。这是 dir 的一个特性 - 它只 returns 文件名而不是文件路径。很容易解决，只需将代码中的相关行更改为：
Set OpenPresentation = Presentations.Open(SourceFolder & "\" & PresentationToProcess)
查看其余代码，您会遇到另一个问题 - 您稍后尝试将下一个文件名分配给对象 OpenPresentation。结合前面的 On Error 语句，这将无限循环您的代码。这应该更改为：
PresentationToProcess = Dir
完整修改后的代码如下。希望对您有所帮助 - 如果您有任何问题，请告诉我。
Sub ExportPPTSlidesToSingles()
''Application.DisplayAlerts = False
Dim oPptApp As PowerPoint.Application
'Initial directory path.
Dim IntialPath As String
Dim SourceDialogBox As FileDialog
Dim TargetDialogBox As FileDialog
Dim SourceFolder As String
Dim TargetFolder As String
Dim SourceFile As Presentation
Dim TempPresentation As Presentation
Dim PresentationToProcess As String
Dim counter As Long
Dim OpenPresentation As Presentation
Dim TargetFileName As String
Set oPptApp = CreateObject("PowerPoint.Application")
Set SourceDialogBox = oPptApp.FileDialog(msoFileDialogFolderPicker)
Set TargetDialogBox = oPptApp.FileDialog(msoFileDialogFolderPicker)
ActiveWindow.ViewType = ppViewNormal
IntialPath = "D:\_ infographics\temp\"
'Select source data folder
MsgBox ("Select a SOURCE folder where input Powerpoint files are located.")
Set SourceDialogBox = Application.FileDialog(msoFileDialogFolderPicker)
If SourceDialogBox.Show = -1 Then
SourceFolder = SourceDialogBox.SelectedItems(1)
End If
'Select target data folder
MsgBox ("Select a TARGET folder - where the individual files will be saved.")
If TargetDialogBox.Show = -1 Then
TargetFolder = TargetDialogBox.SelectedItems(1)
End If
If MsgBox("Depending on the number of visible slides to export and the size " & _
"of your presentation, this might take some time." & vbCrLf & vbCrLf & "Continue?", _
vbYesNo + vbQuestion, _
"Export " & counter & " Visible Slides to Presentations") = vbNo Then Exit Sub
'Loop through only pptx files in source folder
PresentationToProcess = Dir(SourceFolder & "\*.ppt*")
MsgBox PresentationToProcess
While PresentationToProcess <> ""
' Open source files
Set OpenPresentation = Presentations.Open(SourceFolder & "\" & PresentationToProcess)
On Error GoTo errorhandler
' Make a temoprary copy
TempPresentation.SaveCopyAs (Environ("TEMP") & "\temppres.pptx")
On Error Resume Next
Set TempPresentation = Presentations.Open(FileName:=Environ("TEMP") & "\temppres.pptx", WithWindow:=False)
' Loop through slides
For counter = OpenPresentation.Slides.count To 1 Step -1
OpenPresentation.Slides(counter).Copy
TempPresentation.Slides.Paste
' Create a unique filename and save a copy of each slide
TargetFileName = Left(ActivePresentation.Name, InStrRev(ActivePresentation.Name, ".") - 1) & " [" & counter & "].pptx"
Call TempPresentation.SaveAs(FileName:=Environ("USERPROFILE") & "\Desktop\slides\" & TargetFileName & counter & ".pptx", EmbedTrueTypeFonts:=False)
TempPresentation.Slides(1).Delete
Next counter
TempPresentation.Close
OpenPresentation.Close
PresentationToProcess = Dir
Wend
'Close the ppt
oPptApp.Presentations.Application.Quit
On Error GoTo 0
Exit Sub
errorhandler:
Debug.Print Err, Err.Description
Resume Next
End Sub
我正在尝试编写一个子程序，将 Powerpoint 文件的各个幻灯片保存在用户 select 目录中，并将它们保存在另一个用户 selected 目录中。
源和目标对话框似乎工作正常，但我得到 'Method' 打开对象 'Presentation'。我解决不了。
另外，如果我想在循环中同时处理ppt和pptx时间文件，我应该做哪些更改。
最后，需要做些什么才能使其递归处理 selected 文件夹和所有子文件夹。
我知道很多 提前购买谢谢。
胡安
这是代码
Sub ExportPPTSlidesToSingles()
''Application.DisplayAlerts = False
Dim oPptApp As PowerPoint.Application
'Initial directory path.
Dim IntialPath As String
Dim SourceDialogBox As FileDialog
Dim TargetDialogBox As FileDialog
Dim SourceFolder As String
Dim TargetFolder As String
Dim SourceFile As Presentation
Dim TempPresentation As Presentation
Dim PresentationToProcess As String
Dim counter As Long
Dim OpenPresentation As Presentation
Dim TargetFileName As String
Set oPptApp = CreateObject("PowerPoint.Application")
Set SourceDialogBox = oPptApp.FileDialog(msoFileDialogFolderPicker)
Set TargetDialogBox = oPptApp.FileDialog(msoFileDialogFolderPicker)
ActiveWindow.ViewType = ppViewNormal
IntialPath = "D:\_ infographics\temp\"
'Select source data folder
MsgBox ("Select a SOURCE folder where input Powerpoint files are located.")
Set SourceDialogBox = Application.FileDialog(msoFileDialogFolderPicker)
If SourceDialogBox.Show = -1 Then
SourceFolder = SourceDialogBox.SelectedItems(1)
End If
'Select target data folder
MsgBox ("Select a TARGET folder - where the individual files will be saved.")
If TargetDialogBox.Show = -1 Then
TargetFolder = TargetDialogBox.SelectedItems(1)
End If
If MsgBox("Depending on the number of visible slides to export and the size " & _
"of your presentation, this might take some time." & vbCrLf & vbCrLf & "Continue?", _
vbYesNo + vbQuestion, _
"Export " & counter & " Visible Slides to Presentations") = vbNo Then Exit Sub
'Loop through only pptx files in source folder
PresentationToProcess = Dir(SourceFolder & "\*.ppt*")
MsgBox PresentationToProcess
While PresentationToProcess <> ""
' Open source files
Set OpenPresentation = Presentations.Open(PresentationToProcess)
On Error GoTo errorhandler
' Make a temoprary copy
TempPresentation.SaveCopyAs (Environ("TEMP") & "\temppres.pptx")
On Error Resume Next
Set TempPresentation = Presentations.Open(FileName:=Environ("TEMP") & "\temppres.pptx", WithWindow:=False)
' Loop through slides
For counter = OpenPresentation.Slides.count To 1 Step -1
OpenPresentation.Slides(counter).Copy
TempPresentation.Slides.Paste
' Create a unique filename and save a copy of each slide
TargetFileName = Left(ActivePresentation.Name, InStrRev(ActivePresentation.Name, ".") - 1) & " [" & counter & "].pptx"
Call TempPresentation.SaveAs(FileName:=Environ("USERPROFILE") & "\Desktop\slides\" & TargetFileName & counter & ".pptx", EmbedTrueTypeFonts:=False)
TempPresentation.Slides(1).Delete
Next counter
TempPresentation.Close
OpenPresentation.Close
OpenPresentation = Dir
Wend
'Close the ppt
oPptApp.Presentations.Application.Quit
On Error GoTo 0
Exit Sub
errorhandler:
Debug.Print Err, Err.Description
Resume Next
End Sub
PresentationToProcess 只是文件名（Dir 不是 return 完整路径）所以你需要在调用 Open()[ 之前添加路径=16=]
Set OpenPresentation = Presentations.Open(SourceFolder & "\" & PresentationToProcess)
您的 Dir(SourceFolder & "\*.ppt*") 应该已经找到 .pptx 和 .ppt 文件类型。
这里有很多关于如何通过子文件夹递归搜索的以前的帖子 - 尝试从其中一个帖子中找到答案。 例如：Loop Through Sub-Dir
所以你遇到这个错误是因为代码没有使用它试图加载的源文件的完整路径。这是 dir 的一个特性 - 它只 returns 文件名而不是文件路径。很容易解决，只需将代码中的相关行更改为：
Set OpenPresentation = Presentations.Open(SourceFolder & "\" & PresentationToProcess)
查看其余代码，您会遇到另一个问题 - 您稍后尝试将下一个文件名分配给对象 OpenPresentation。结合前面的 On Error 语句，这将无限循环您的代码。这应该更改为：
PresentationToProcess = Dir
完整修改后的代码如下。希望对您有所帮助 - 如果您有任何问题，请告诉我。
Sub ExportPPTSlidesToSingles()
''Application.DisplayAlerts = False
Dim oPptApp As PowerPoint.Application
'Initial directory path.
Dim IntialPath As String
Dim SourceDialogBox As FileDialog
Dim TargetDialogBox As FileDialog
Dim SourceFolder As String
Dim TargetFolder As String
Dim SourceFile As Presentation
Dim TempPresentation As Presentation
Dim PresentationToProcess As String
Dim counter As Long
Dim OpenPresentation As Presentation
Dim TargetFileName As String
Set oPptApp = CreateObject("PowerPoint.Application")
Set SourceDialogBox = oPptApp.FileDialog(msoFileDialogFolderPicker)
Set TargetDialogBox = oPptApp.FileDialog(msoFileDialogFolderPicker)
ActiveWindow.ViewType = ppViewNormal
IntialPath = "D:\_ infographics\temp\"
'Select source data folder
MsgBox ("Select a SOURCE folder where input Powerpoint files are located.")
Set SourceDialogBox = Application.FileDialog(msoFileDialogFolderPicker)
If SourceDialogBox.Show = -1 Then
SourceFolder = SourceDialogBox.SelectedItems(1)
End If
'Select target data folder
MsgBox ("Select a TARGET folder - where the individual files will be saved.")
If TargetDialogBox.Show = -1 Then
TargetFolder = TargetDialogBox.SelectedItems(1)
End If
If MsgBox("Depending on the number of visible slides to export and the size " & _
"of your presentation, this might take some time." & vbCrLf & vbCrLf & "Continue?", _
vbYesNo + vbQuestion, _
"Export " & counter & " Visible Slides to Presentations") = vbNo Then Exit Sub
'Loop through only pptx files in source folder
PresentationToProcess = Dir(SourceFolder & "\*.ppt*")
MsgBox PresentationToProcess
While PresentationToProcess <> ""
' Open source files
Set OpenPresentation = Presentations.Open(SourceFolder & "\" & PresentationToProcess)
On Error GoTo errorhandler
' Make a temoprary copy
TempPresentation.SaveCopyAs (Environ("TEMP") & "\temppres.pptx")
On Error Resume Next
Set TempPresentation = Presentations.Open(FileName:=Environ("TEMP") & "\temppres.pptx", WithWindow:=False)
' Loop through slides
For counter = OpenPresentation.Slides.count To 1 Step -1
OpenPresentation.Slides(counter).Copy
TempPresentation.Slides.Paste
' Create a unique filename and save a copy of each slide
TargetFileName = Left(ActivePresentation.Name, InStrRev(ActivePresentation.Name, ".") - 1) & " [" & counter & "].pptx"
Call TempPresentation.SaveAs(FileName:=Environ("USERPROFILE") & "\Desktop\slides\" & TargetFileName & counter & ".pptx", EmbedTrueTypeFonts:=False)
TempPresentation.Slides(1).Delete
Next counter
TempPresentation.Close
OpenPresentation.Close
PresentationToProcess = Dir
Wend
'Close the ppt
oPptApp.Presentations.Application.Quit
On Error GoTo 0
Exit Sub
errorhandler:
Debug.Print Err, Err.Description
Resume Next
End Sub