尝试打开 PowerPoint 演示文稿时出现 Excel VBA 错误 467

Question

代码目标：如果 PowerPoint 已打开并且搜索到的演示文稿已打开，则更新它。如果演示文稿已关闭，请打开它。如果 PowerPoint 已关闭，则创建一个新实例。

错误：在过去 2 周多个用户在多台计算机上运行它后，今天其中一位用户收到以下错误消息：

运行时错误 467：远程服务器计算机不存在或 不可用

在调试模式下突出显示的行代码：

Set ppPres = ppProgram.Presentations.Item(i)

模块代码的相关部分：

Public Sub UpdatePowerPoint(PowerPointFile)   

Dim ppProgram                           As PowerPoint.Application
Dim ppPres                              As PowerPoint.Presentation
Dim ppFullPath                          As String
Dim ppName                              As String
Dim activeSlide                         As PowerPoint.Slide

Dim cht                                 As Excel.ChartObject
Dim myShape                             As Object
Dim myChart                             As Object
Dim SlideNum, GPLRank                   As Integer
Dim ShapeNum                            As Integer
Dim shapeStageStat                      As Shape

On Error Resume Next
Set ppProgram = GetObject(, "PowerPoint.Application")
On Error GoTo 0

ppFullPath = PowerPointFile
PPT_Export_Success = True

' check if PowerPoint instance is open
If ppProgram Is Nothing Then
    Set ppProgram = New PowerPoint.Application
    i = 1
Else
    If ppProgram.Presentations.count > 0 Then
        ppName = Mid(ppFullPath, InStrRev(ppFullPath, "\") + 1, Len(ppFullPath))
        i = 1
        ppCount = ppProgram.Presentations.count
        Do Until i = ppCount + 1
            If ppProgram.Presentations.Item(i).Name = ppName Then
                Set ppPres = ppProgram.Presentations.Item(i)
                GoTo OnePager_Pres_Found
            Else
                i = i + 1
            End If
        Loop
    End If
End If

ppProgram.Presentations.Open Filename:=PowerPointFile

' *** Getting the ERROR at the line below ***
Set ppPres = ppProgram.Presentations.Item(i)

OnePager_Pres_Found:
ppPres.Windows(1).Activate  ' activate the One-Pager Presentation in case you have several open, and the One_pager is currently not the app "on-focus"

' --- Added Class script to allow PowerPoint ScreenUpdating set to FALSE ---
Dim myClass_PPT                         As Class_PPT

Set myClass_PPT = New Class_PPT
myClass_PPT.ScreenUpdating = False

' loop through all PowerPoint Slides, and copy all Chart objects from Excel
For ProjectCounter = 0 To NumberofProjectShts
    ' copying charts, shapes and other objects

Next ' ProjectCounter = 0 To NumberofProjectShts

AppActivate ("Microsoft PowerPoint")
Set activeSlide = Nothing
Set ppPres = Nothing
Set ppProgram = Nothing

End Sub

Answer 1

您的代码 - 摘录如下 - 对我来说有点奇怪：

' check if PowerPoint instance is open
If ppProgram Is Nothing Then
    Set ppProgram = New PowerPoint.Application
    i = 1
Else
    If ppProgram.Presentations.count > 0 Then
        ppName = Mid(ppFullPath, InStrRev(ppFullPath, "\") + 1, Len(ppFullPath))
        i = 1
        ppCount = ppProgram.Presentations.count
        Do Until i = ppCount + 1
            If ppProgram.Presentations.Item(i).Name = ppName Then
                Set ppPres = ppProgram.Presentations.Item(i)
                GoTo OnePager_Pres_Found
            Else
                i = i + 1
            End If
        Loop
    End If
End If

ppProgram.Presentations.Open Filename:=PowerPointFile

' *** Getting the ERROR at the line below ***
Set ppPres = ppProgram.Presentations.Item(i)

OnePager_Pres_Found:
ppPres.Windows(1).Activate  ' activate the One-Pager Presentation in case you have several open, and the One_pager is currently not the app "on-focus"

如果打开 Powerpoint 时带有一些演示文稿但不是您想要的演示文稿 (PowerPointFile)， 在给您错误的行上，您要做什么？ （i 等于 Presentations.count）

我觉得不对，应该换成之前一行刚打开的ActivePresentation。

也许您可以稍微重构一下代码以获得更清晰的结构/案例处理。