VBA Activepresentation.Saveas 错误 - 429 ActiveX答案

【问题标题】：VBA Activepresentation.Saveas Error - 429 ActiveXVBA Activepresentation.Saveas 错误 - 429 ActiveX
【发布时间】：2018-05-03 16:53:19
【问题描述】：

我正在尝试运行以下代码，当我到达 ActivePresentation.SaveAs 时出现以下错误

错误 - 运行时错误“429”：ActiveX 组件无法创建对象。

我已经搜索了这个问题，但似乎找不到明确的答案，一些线程表明这可能是一个参考问题，但是我已经更新了我的参考并且问题仍然存在。

Public Sub SaveNewVersion_PowerPoint()
'PURPOSE: Save file, if already exists add a new version indicator to filename
'SOURCE: www.TheSpreadsheetGuru.com/The-Code-Vault

Dim FolderPath As String
Dim myPath As String
Dim SaveName As String
Dim SaveExt As String
Dim VersionExt As String
Dim Saved As Boolean
Dim x As Long
Dim TestStr As String
Dim myFileName As String


TestStr = ""
Saved = False
x = 2

'Version Indicator (change to liking)
  VersionExt = "_v"

'Pull info about file
  On Error GoTo NotSavedYet
    myPath = "C:\Users\Person\Desktop\Test\Weekly Pack Update.pptx"
    myFileName = Mid(myPath, InStrRev(myPath, "\") + 1, InStrRev(myPath, ".") - InStrRev(myPath, "\") - 1)
    FolderPath = Left(myPath, InStrRev(myPath, "\"))
    SaveExt = "." & Right(myPath, Len(myPath) - InStrRev(myPath, "."))
  On Error GoTo 0

'Determine if file has ever been saved
  If FolderPath = "" Then
    MsgBox "This file has not been initially saved. " & _
    "Cannot save a new version!", vbCritical, "Not Saved To Computer"
    Exit Sub
  End If

'Determine Base File Name
  If InStr(1, myFileName, VersionExt) > 1 Then
    myArray = Split(myFileName, VersionExt)
    SaveName = myArray(0)
  Else
    SaveName = myFileName
  End If

'Test to see if file name already exists
  If FileExist(FolderPath & SaveName & SaveExt) = False Then
    ActivePresentation.SaveAs FolderPath & SaveName & SaveExt 'Errors Here
    Exit Sub
  End If

'Need a new version made
  Do While Saved = False
    If FileExist(FolderPath & SaveName & VersionExt & x & SaveExt) = False Then
      ActivePresentation.SaveAs FolderPath & SaveName & VersionExt & x & SaveExt 'Error Here
      Saved = True
    Else
      x = x + 1
    End If
  Loop

'New version saved
  MsgBox "New file version saved (version " & x & ")"

Exit Sub

'Error Handler
NotSavedYet:
  MsgBox "This file has not been initially saved. " & _
    "Cannot save a new version!", vbCritical, "Not Saved To Computer"

End Sub

【问题讨论】：

真的有一个演示文稿打开了吗？你能在即时窗口中解决它吗？您可以在用户界面中使用 SaveAs 吗？您确定所有变量都具有预期值并连接到可行的文件路径吗？
演示文稿已打开，并且是唯一打开的演示文稿，我可以使用用户 UI 保存，我检查了变量，它们确实提供了可行的路径，但不确定您所说的即时窗口到底是什么意思虽然很抱歉

标签： vba powerpoint

【解决方案1】：

我不能声称理解这是如何解决它的，但我声明了

Dim ppApp   As PowerPoint.Application
Dim ppPres  As PowerPoint.Presentation

然后加入

Set ppApp = New PowerPoint.Application
i = 1

ppApp.Presentations.Open Filename:=myPath
Set ppPres = ppApp.Presentations.Item(i)

终于变了

Activepresentation.saveAs

到

ppPres.SaveAs

并且成功了完整代码如下：

Public Sub SaveNewVersion_PowerPoint()
'PURPOSE: Save file, if already exists add a new version indicator to filename
'SOURCE: www.TheSpreadsheetGuru.com/The-Code-Vault

Dim FolderPath As String
Dim myPath As String
Dim SaveName As String
Dim SaveExt As String
Dim VersionExt As String
Dim Saved As Boolean
Dim x As Long
Dim TestStr As String
Dim myFileName As String


TestStr = ""
Saved = False
x = 2

'Version Indicator (change to liking)
  VersionExt = "_v"

'Pull info about file
  On Error GoTo NotSavedYet
    myPath = "C:\Users\Person\Desktop\Test\Weekly Pack Update.pptx"
    myFileName = Mid(myPath, InStrRev(myPath, "\") + 1, InStrRev(myPath, ".") - InStrRev(myPath, "\") - 1)
    FolderPath = Left(myPath, InStrRev(myPath, "\"))
    SaveExt = "." & Right(myPath, Len(myPath) - InStrRev(myPath, "."))
  On Error GoTo 0

'Determine if file has ever been saved
  If FolderPath = "" Then
    MsgBox "This file has not been initially saved. " & _
    "Cannot save a new version!", vbCritical, "Not Saved To Computer"
    Exit Sub
  End If

'Determine Base File Name
  If InStr(1, myFileName, VersionExt) > 1 Then
    myArray = Split(myFileName, VersionExt)
    SaveName = myArray(0)
  Else
    SaveName = myFileName
  End If

'Test to see if file name already exists
  If FileExist(FolderPath & SaveName & SaveExt) = False Then
    ActivePresentation.SaveAs FolderPath & SaveName & SaveExt 'Errors Here
    Exit Sub
  End If

'Need a new version made
  Do While Saved = False
    If FileExist(FolderPath & SaveName & VersionExt & x & SaveExt) = False Then
      ActivePresentation.SaveAs FolderPath & SaveName & VersionExt & x & SaveExt 'Error Here
      Saved = True
    Else
      x = x + 1
    End If
  Loop

'New version saved
  MsgBox "New file version saved (version " & x & ")"

Exit Sub

'Error Handler
NotSavedYet:
  MsgBox "This file has not been initially saved. " & _
    "Cannot save a new version!", vbCritical, "Not Saved To Computer"

End Sub

【讨论】：