Vba 试图使用处理捕获运行时错误-2147188160（80048240）

我试图使用

On Error GoTo Handle

捕获不一致的

运行时错误-2147188160（80048240）

我的代码从excel模板生成4个powerpoints，保存并关闭它们。下面是我在底部的实验性错误处理：

'Exit PowerPoint
PPT.Quit
Exit Sub

Handle:
If Err.Number = -2147188160 Then
    PPT.Quit
    MsgBox "Hey look I broke!"
End If
End Sub

但是在我的测试中，当我遇到错误时，我没有得到任何错误消息，但是我的代码也没有运行。这让我相信我抓住了错误，但其他东西没有触发。我以前尝试过解决错误的根本原因，但解决方法是只添加

应用程序。在我的代码中等待
，我觉得这是不必要的

在一个完美的世界里，我只想捕捉错误，关闭PowerPoint，让它立即重新运行代码。有什么见解吗

相关人员的完整子程序-错误位置不一致：

Public Declare Function GetWindowThreadProcessId Lib "user32" _
      (ByVal hwnd As Long, lpdwprocessid As Long) As Long
Sub GeneratePowerPoints()

'For using powerpoint
Dim dummyfile As String
Dim PPT As PowerPoint.Application
Dim myPresentation As PowerPoint.Presentation
Dim MySlide As Object
Dim MyShape As Object

Dim j As Long, allhotels() As Variant, sourcerange As Range, sourcebook As String
Dim d As Date, e As Date, f As Date, lastmonth As String, twomonthsago As String, threemonthsago As String

'Get some month names
d = DateAdd("m", -1, Now)
e = DateAdd("m", -2, Now)
f = DateAdd("m", -3, Now)
lastmonth = Format(d, "mmmm")
twomonthsago = Format(e, "mmmm")
threemonthsago = Format(f, "mmmm")

sourcebook = "BT Strat Sheet.xlsm"
allhotels = Array("SBH", "WBOS", "WBW", "WCP")
dummyfile = "P:\BT\BT 2017\BT Strategy Meetings\2017\Hotel Strat Meeting Dummy File.pptx"

On Error GoTo Handle
For j = 0 To 3

    Set PPT = New PowerPoint.Application
    PPT.Visible = True
    PPT.Presentations.Open Filename:=dummyfile

    'SLIDE ONE
    Set sourcerange = Workbooks(sourcebook).Worksheets(allhotels(j)).Range("A2:J21")
    sourcerange.Copy
    PPT.ActivePresentation.Slides(1).Shapes.PasteSpecial DataType:=2
    Set MyShape = PPT.ActivePresentation.Slides(1).Shapes(PPT.ActivePresentation.Slides(1).Shapes.Count)

    'Set size
    MyShape.Left = 152
    MyShape.Top = 152
    MyShape.Height = 500
    MyShape.Width = 650

    'SLIDE TWO
    Set sourcerange = Workbooks(sourcebook).Worksheets(allhotels(j)).Range("A82:J91")
    sourcerange.Copy
    PPT.ActivePresentation.Slides(2).Shapes.PasteSpecial DataType:=2
    Set MyShape = PPT.ActivePresentation.Slides(2).Shapes(PPT.ActivePresentation.Slides(2).Shapes.Count)

    'Set size
    MyShape.Left = 152
    MyShape.Top = 92
    MyShape.Height = 500
    MyShape.Width = 650

    'SLIDE TWO
    Set sourcerange = Workbooks(sourcebook).Worksheets(allhotels(j)).Range("A94:J103")
    sourcerange.Copy
    PPT.ActivePresentation.Slides(2).Shapes.PasteSpecial DataType:=2
    Set MyShape = PPT.ActivePresentation.Slides(2).Shapes(PPT.ActivePresentation.Slides(2).Shapes.Count)

    'Set size
    MyShape.Left = 152
    MyShape.Top = 300
    MyShape.Height = 500
    MyShape.Width = 650

    'SLIDE THREE
    Set sourcerange = Workbooks(sourcebook).Worksheets(allhotels(j)).Range("A24:J43")
    sourcerange.Copy
    PPT.ActivePresentation.Slides(3).Shapes.PasteSpecial DataType:=2
    Set MyShape = PPT.ActivePresentation.Slides(3).Shapes(PPT.ActivePresentation.Slides(3).Shapes.Count)

    'Set size
    MyShape.Left = 152
    MyShape.Top = 152
    MyShape.Height = 500
    MyShape.Width = 650

    'SLIDE FOUR
    Set sourcerange = Workbooks(sourcebook).Worksheets(allhotels(j)).Range("A58:J67")
    sourcerange.Copy
    PPT.ActivePresentation.Slides(4).Shapes.PasteSpecial DataType:=2
    Set MyShape = PPT.ActivePresentation.Slides(4).Shapes(PPT.ActivePresentation.Slides(4).Shapes.Count)

    'Set size
    MyShape.Left = 152
    MyShape.Top = 120
    MyShape.Height = 500
    MyShape.Width = 650

    'SLIDE FOUR
    Set sourcerange = Workbooks(sourcebook).Worksheets(allhotels(j)).Range("A46:J55")
    sourcerange.Copy
    PPT.ActivePresentation.Slides(4).Shapes.PasteSpecial DataType:=2
    Set MyShape = PPT.ActivePresentation.Slides(4).Shapes(PPT.ActivePresentation.Slides(4).Shapes.Count)

    'Set size
    MyShape.Left = 152
    MyShape.Top = 335
    MyShape.Height = 500
    MyShape.Width = 650

    'SLIDE FIVE
    Set sourcerange = Workbooks(sourcebook).Worksheets(allhotels(j)).Range("A70:J79")
    sourcerange.Copy
    PPT.ActivePresentation.Slides(5).Shapes.PasteSpecial DataType:=2
    Set MyShape = PPT.ActivePresentation.Slides(5).Shapes(PPT.ActivePresentation.Slides(5).Shapes.Count)

    'Set size
    MyShape.Left = 152
    MyShape.Top = 152
    MyShape.Height = 500
    MyShape.Width = 650

    'Find and replace month placeholders
    'Straight boilerplate
    Dim sld As Slide, shp As PowerPoint.Shape, i As Long

    For Each sld In PPT.ActivePresentation.Slides
        For Each shp In sld.Shapes
            If shp.HasTextFrame Then
                If shp.TextFrame.HasText Then
                    shp.TextFrame.TextRange.Text = Replace(shp.TextFrame.TextRange.Text, "LastMonth", lastmonth)
                End If
            End If
        Next shp
    Next sld

    For Each sld In PPT.ActivePresentation.Slides
        For Each shp In sld.Shapes
            If shp.HasTextFrame Then
                If shp.TextFrame.HasText Then
                    shp.TextFrame.TextRange.Text = Replace(shp.TextFrame.TextRange.Text, "TwoMonthsAgo", twomonthsago)
                End If
            End If
        Next shp
    Next sld

    For Each sld In PPT.ActivePresentation.Slides
        For Each shp In sld.Shapes
            If shp.HasTextFrame Then
                If shp.TextFrame.HasText Then
                    shp.TextFrame.TextRange.Text = Replace(shp.TextFrame.TextRange.Text, "ThreeMonthsAgo", threemonthsago)
                End If
            End If
        Next shp
    Next sld

    'Save it
    PPT.ActivePresentation.SaveAs "P:\BT\BT File Drop-off Location\" & allhotels(j) & " " & lastmonth & " Strat Meeting.pptx"

    'Close it
    PPT.ActivePresentation.Close
Next j

'Exit PowerPoint
PPT.Quit
Exit Sub

Handle:
Call KillProcess(PPT)
MsgBox "Hey look I broke!"

End Sub
Sub KillProcess(ByVal app As PowerPoint.Application)

    ' This is OK Here, Because We Can Assume If We Get No Handle Back, There's No Handle To Cleanup
    ' Don't Normally Do This
    On Error Resume Next

    Dim windowProcessId As Long
    windowProcessId = ProcIDFromWnd(app.ActiveWindow.hwnd)

    Dim oServ As Object
    Dim cProc As Variant
    Dim oProc As Object

    Set oServ = GetObject("winmgmts:")
    Set cProc = oServ.ExecQuery("Select * from Win32_Process Where ProcessId=" & windowProcessId)

    For Each oProc In cProc

          MsgBox "Killing Process " & windowProcessId   ' used to display a message for testing pur
          errReturnCode = oProc.Terminate()
    Next

End Sub
Function ProcIDFromWnd(ByVal hwnd As Long) As Long
   Dim idProc As Long

   ' Get PID for this HWnd
   GetWindowThreadProcessId hwnd, idProc
   ProcIDFromWnd = idProc
End Function

编辑：根据苦艾酒的建议，我能够调试。打印以确认错误号确实是-2147188160。我现在只能在出现错误时成功运行代码，但是我无法让PowerPoint退出-我必须自己关闭PowerPoint，然后我可以看到
MsgBox
出现在我的excel屏幕上：

'Exit PowerPoint
PPT.Quit
Exit Sub

Handle:
Debug.Print Err.Number
If Err.Number = -2147188160 Then
PPT.Quit
MsgBox "Oh look I broke!"
End If

这可能是由于在宏运行时引发了另一个带有另一个错误号的错误。为了避免丢失此错误，如果号码不是您想要的号码，您可以添加其他消息

Handle:
If Err.Number = -2147188160 Then
    PPT.Quit
    MsgBox "Hey look I broke!"
else
    MsgBox("Run-time error '" & Err.Number & "': " & Err.Description, vbCritical, "Error")
End If

如果PowerPoint没有退出，可能是因为有一些公开的参考资料。由于错误，您处于一种奇怪的状态，因此我建议您终止与主窗口句柄关联的进程（不建议在异常状态下这样做）

在这种情况下，您需要知道哪些PPT流程是由自动化启动的，并终止这些流程

此进程在开始时获取进程（仅限PPT）并在结束时获取进程，然后终止新进程

Public PpProcesses() As Integer

Sub GeneratePowerPoints()


    Call SaveProcesses

'For using powerpoint
Dim dummyfile As String
Dim PPT As PowerPoint.Application
Dim myPresentation As PowerPoint.Presentation
Dim MySlide As Object
Dim MyShape As Object

Dim j As Long, allhotels() As Variant, sourcerange As Range, sourcebook As String
Dim d As Date, e As Date, f As Date, lastmonth As String, twomonthsago As String, threemonthsago As String

'Get some month names
d = DateAdd("m", -1, Now)
e = DateAdd("m", -2, Now)
f = DateAdd("m", -3, Now)
lastmonth = Format(d, "mmmm")
twomonthsago = Format(e, "mmmm")
threemonthsago = Format(f, "mmmm")

sourcebook = "BT Strat Sheet.xlsm"
allhotels = Array("SBH", "WBOS", "WBW", "WCP")
dummyfile = "P:\BT\BT 2017\BT Strategy Meetings\2017\Hotel Strat Meeting Dummy File.pptx"

On Error GoTo Handle
For j = 0 To 3

    Set PPT = New PowerPoint.Application
    PPT.Visible = True
    PPT.Presentations.Open Filename:=dummyfile

    'SLIDE ONE
    Set sourcerange = Workbooks(sourcebook).Worksheets(allhotels(j)).Range("A2:J21")
    sourcerange.Copy
    PPT.ActivePresentation.Slides(1).Shapes.PasteSpecial DataType:=2
    Set MyShape = PPT.ActivePresentation.Slides(1).Shapes(PPT.ActivePresentation.Slides(1).Shapes.Count)

    'Set size
    MyShape.Left = 152
    MyShape.Top = 152
    MyShape.Height = 500
    MyShape.Width = 650

    'SLIDE TWO
    Set sourcerange = Workbooks(sourcebook).Worksheets(allhotels(j)).Range("A82:J91")
    sourcerange.Copy
    PPT.ActivePresentation.Slides(2).Shapes.PasteSpecial DataType:=2
    Set MyShape = PPT.ActivePresentation.Slides(2).Shapes(PPT.ActivePresentation.Slides(2).Shapes.Count)

    'Set size
    MyShape.Left = 152
    MyShape.Top = 92
    MyShape.Height = 500
    MyShape.Width = 650

    'SLIDE TWO
    Set sourcerange = Workbooks(sourcebook).Worksheets(allhotels(j)).Range("A94:J103")
    sourcerange.Copy
    PPT.ActivePresentation.Slides(2).Shapes.PasteSpecial DataType:=2
    Set MyShape = PPT.ActivePresentation.Slides(2).Shapes(PPT.ActivePresentation.Slides(2).Shapes.Count)

    'Set size
    MyShape.Left = 152
    MyShape.Top = 300
    MyShape.Height = 500
    MyShape.Width = 650

    'SLIDE THREE
    Set sourcerange = Workbooks(sourcebook).Worksheets(allhotels(j)).Range("A24:J43")
    sourcerange.Copy
    PPT.ActivePresentation.Slides(3).Shapes.PasteSpecial DataType:=2
    Set MyShape = PPT.ActivePresentation.Slides(3).Shapes(PPT.ActivePresentation.Slides(3).Shapes.Count)

    'Set size
    MyShape.Left = 152
    MyShape.Top = 152
    MyShape.Height = 500
    MyShape.Width = 650

    'SLIDE FOUR
    Set sourcerange = Workbooks(sourcebook).Worksheets(allhotels(j)).Range("A58:J67")
    sourcerange.Copy
    PPT.ActivePresentation.Slides(4).Shapes.PasteSpecial DataType:=2
    Set MyShape = PPT.ActivePresentation.Slides(4).Shapes(PPT.ActivePresentation.Slides(4).Shapes.Count)

    'Set size
    MyShape.Left = 152
    MyShape.Top = 120
    MyShape.Height = 500
    MyShape.Width = 650

    'SLIDE FOUR
    Set sourcerange = Workbooks(sourcebook).Worksheets(allhotels(j)).Range("A46:J55")
    sourcerange.Copy
    PPT.ActivePresentation.Slides(4).Shapes.PasteSpecial DataType:=2
    Set MyShape = PPT.ActivePresentation.Slides(4).Shapes(PPT.ActivePresentation.Slides(4).Shapes.Count)

    'Set size
    MyShape.Left = 152
    MyShape.Top = 335
    MyShape.Height = 500
    MyShape.Width = 650

    'SLIDE FIVE
    Set sourcerange = Workbooks(sourcebook).Worksheets(allhotels(j)).Range("A70:J79")
    sourcerange.Copy
    PPT.ActivePresentation.Slides(5).Shapes.PasteSpecial DataType:=2
    Set MyShape = PPT.ActivePresentation.Slides(5).Shapes(PPT.ActivePresentation.Slides(5).Shapes.Count)

    'Set size
    MyShape.Left = 152
    MyShape.Top = 152
    MyShape.Height = 500
    MyShape.Width = 650

    'Find and replace month placeholders
    'Straight boilerplate
    Dim sld As Slide, shp As PowerPoint.Shape, i As Long

    For Each sld In PPT.ActivePresentation.Slides
        For Each shp In sld.Shapes
            If shp.HasTextFrame Then
                If shp.TextFrame.HasText Then
                    shp.TextFrame.TextRange.Text = Replace(shp.TextFrame.TextRange.Text, "LastMonth", lastmonth)
                End If
            End If
        Next shp
    Next sld

    For Each sld In PPT.ActivePresentation.Slides
        For Each shp In sld.Shapes
            If shp.HasTextFrame Then
                If shp.TextFrame.HasText Then
                    shp.TextFrame.TextRange.Text = Replace(shp.TextFrame.TextRange.Text, "TwoMonthsAgo", twomonthsago)
                End If
            End If
        Next shp
    Next sld

    For Each sld In PPT.ActivePresentation.Slides
        For Each shp In sld.Shapes
            If shp.HasTextFrame Then
                If shp.TextFrame.HasText Then
                    shp.TextFrame.TextRange.Text = Replace(shp.TextFrame.TextRange.Text, "ThreeMonthsAgo", threemonthsago)
                End If
            End If
        Next shp
    Next sld

    'Save it
    PPT.ActivePresentation.SaveAs "P:\BT\BT File Drop-off Location\" & allhotels(j) & " " & lastmonth & " Strat Meeting.pptx"

    'Close it
    PPT.ActivePresentation.Close
Next j

'Exit PowerPoint
PPT.Quit
Exit Sub

Handle:
MsgBox Err.Number
Call KillProcess
MsgBox "Hey look I broke!"

End Sub


Public Sub SaveProcesses()

    ReDim PpProcesses(1 To 1)

    Dim oServ As Object
    Dim cProc As Variant
    Dim oProc As Object

    Set oServ = GetObject("winmgmts:")
    Set cProc = oServ.ExecQuery("Select * from Win32_Process")

    For Each oProc In cProc

        If UCase(oProc.Name) = "POWERPNT.EXE" Or UCase(oProc.Name) = "POWERPNT" Then

            ReDim Preserve PpProcesses(1 To UBound(PpProcesses) + 1)
            PpProcesses(UBound(PpProcesses)) = oProc.ProcessId

        End If
    Next

End Sub

Sub KillProcess()

    Dim index As Integer
    index = -1

    Dim oServ As Object
    Dim cProc As Variant
    Dim oProc As Object

    Set oServ = GetObject("winmgmts:")
    Set cProc = oServ.ExecQuery("Select * from Win32_Process")

    For Each oProc In cProc

         If UCase(oProc.Name) = "POWERPNT.EXE" Or UCase(oProc.Name) = "POWERPNT" Then


            For i = LBound(PpProcesses) To UBound(PpProcesses)
                If PpProcesses(i) = oProc.ProcessId Then
                    index = i
                    Exit For
                End If
            Next i

            If index >= 0 Then
                'MsgBox ("Process Found " & oProc.ProcessId)
            Else
                oProc.Terminate
            End If
         End If
    Next

End Sub

您试图捕获的号码是
-2147188160
，您只测试
-2147024809
，这就是为什么您没有收到消息的原因？@ScottHoltzman好吧，那是我的错-好吧，我将号码换成了-2147024809，现在我根本没有发现错误。我也不能将
-2147188160（80048240）
放在那里而不得到编译错误。。。那么，我应该如何抓住这个问题呢？实际生成错误的代码在哪里？你不想避免抛出那个错误吗？@Mat'smugh我继续添加了它>>所以你创建了四个powerpoint实例，但不是这样。PPT只允许自己有一个实例，除非在某些情况下MS违反了规则。谢谢你的回答-我相信我最初的发现是由于
Err.Number
中的一个错误拼写。目前我仍然对捕获和修复此特定错误特别感兴趣。感谢您的回答-当尝试使用此错误时，我会收到错误“Vba编译错误函数或接口标记为受限，或函数使用Visual Basic不支持的自动化类型”.您介意显示您正在使用的完整代码…一旦包含在其中…错误指向何处？是的，我将发布更新的代码。我得到编译错误，它突出显示
子进程（ByVal app作为PowerPoint.Application
，该子进程突出显示的部分是
windowProcessId=ProcIDFromWnd（app.ActiveWindow.hwnd）中的
.hwnd
无论出于何种原因…ppt没有hwnd属性…必须以稍微不同的方式执行此操作…请查看更新@dwirony@Ctnzkane525太棒了！！！这工作非常完美-这是一个非常好的解决方案，谢谢你的帮助！这将使我的PowerPoint自动创建几乎完美无缺！