vba - 从另一个子系统调用时为 "Automation error: The object invoked has disconnected from its clients."

Question

在阅读了许多具有相同标题的问题后，我仍然在努力防止代码运行时出现标题中的错误。

代码从这里开始:

Option Explicit

Sub Toggle_Click()

    Dim lngMoveBy As Long
    Dim Loop1 As Long
    Dim intShapeNumber As Integer

    intShapeNumber = Right(Application.Caller, Len(Application.Caller) - Len("Toggle"))
    If ThisWorkbook.Sheets("Correction Type Options").Shapes("ToggleBackground" & intShapeNumber).Fill.ForeColor.RGB = RGB(255, 255, 255) Then Toggle_ErrorPrevention intShapeNumber

然后移动到同一模块中的此子:

Sub Toggle_ErrorPrevention(ByVal intShapeNumberVal As Integer)

    Dim lngHLSegmentNumberingRow As Long
    Dim lngClaimRemovalHaveWantedClaimsRow As Long
    Dim lngClaimRemovalHaveUnwantedClaimsRow As Long


    With ThisWorkbook.Sheets("Correction Type Options").Columns(1)
        lngHLSegmentNumberingRow = .Find(What:="HL Segment Numbering", Lookat:=xlWhole).Row

在上面最后一行失败之前，lngHLSegmentNumberingRow = .Find(What:="HL Segment Numbering", Lookat:=xlWhole).Row，并显示“自动化错误:调用的对象已断开连接”来自其客户。”

如果我在发生错误后保存并关闭文档并重新启动它，“更正类型选项”表上的第 1 列将突出显示。

这是我第一次从其他潜艇调用潜艇，因此我一直特别注意调用本身作为问题的潜在根源。我仍然不确定它是否正确。

<小时/>

这是完整的模块，以防有帮助:

Option Explicit

Sub Toggle_Click()

    Dim lngMoveBy As Long
    Dim Loop1 As Long
    Dim intShapeNumber As Integer

    intShapeNumber = Right(Application.Caller, Len(Application.Caller) - Len("Toggle"))
    If ThisWorkbook.Sheets("Correction Type Options").Shapes("ToggleBackground" & intShapeNumber).Fill.ForeColor.RGB = RGB(255, 255, 255) Then Toggle_ErrorPrevention intShapeNumber

    If ThisWorkbook.Sheets("Correction Type Options").Shapes("ToggleBackground" & intShapeNumber).Fill.ForeColor.RGB = RGB(255, 255, 255) Then
        lngMoveBy = 0.6
    Else
        lngMoveBy = -0.6
    End If

    With ThisWorkbook.Sheets("Correction Type Options").Shapes("Toggle" & intShapeNumber)
        For Loop1 = 1 To 24
            .IncrementLeft lngMoveBy
            DoEvents
        Next Loop1
    End With

    If ThisWorkbook.Sheets("Correction Type Options").Shapes("ToggleBackground" & intShapeNumber).Fill.ForeColor.RGB = RGB(255, 255, 255) Then
        With ThisWorkbook.Sheets("Correction Type Options").Shapes("ToggleBackground" & intShapeNumber)
            .Fill.ForeColor.RGB = RGB(0, 255, 0)
            .TextFrame.Characters.Text = "On"
            .TextFrame.Characters.Font.Bold = True
            .TextFrame.Characters.Font.ColorIndex = 1
            .TextFrame.HorizontalAlignment = xlLeft
            .TextFrame.VerticalAlignment = xlCenter
        End With
    Else
        With ThisWorkbook.Sheets("Correction Type Options").Shapes("ToggleBackground" & intShapeNumber)
            .Fill.ForeColor.RGB = RGB(255, 255, 255)
            .TextFrame.Characters.Text = "Off"
            .TextFrame.Characters.Font.Bold = True
            .TextFrame.Characters.Font.ColorIndex = 1
            .TextFrame.HorizontalAlignment = xlRight
            .TextFrame.VerticalAlignment = xlCenter
        End With
    End If

End Sub

Sub Toggle_ErrorPrevention(ByVal intShapeNumberVal As Integer)

    Dim lngHLSegmentNumberingRow As Long
    Dim lngClaimRemovalHaveWantedClaimsRow As Long
    Dim lngClaimRemovalHaveUnwantedClaimsRow As Long


    With ThisWorkbook.Sheets("Correction Type Options").Columns(1)
        lngHLSegmentNumberingRow = .Find(What:="HL Segment Numbering", Lookat:=xlWhole).Row
        lngClaimRemovalHaveWantedClaimsRow = .Find(What:="Claim Removal - Have Wanted Claims", Lookat:=xlWhole).Row
        lngClaimRemovalHaveUnwantedClaimsRow = .Find(What:="Claim Removal - Have Unwanted Claims", Lookat:=xlWhole).Row
    End With

    With ThisWorkbook.Sheets("Correction Type Options")
        If intShapeNumberVal + 1 = lngHLSegmentNumberingRow Then
            If .Shapes("ToggleBackground" & lngClaimRemovalHaveWantedClaimsRow - 1).Fill.ForeColor.RGB = RGB(0, 255, 0) Then Application.Run .Shapes("Toggle" & lngClaimRemovalHaveWantedClaimsRow - 1).OnAction
            If .Shapes("ToggleBackground" & lngClaimRemovalHaveUnwantedClaimsRow - 1).Fill.ForeColor.RGB = RGB(0, 255, 0) Then Application.Run .Shapes("Toggle" & lngClaimRemovalHaveUnwantedClaimsRow - 1).OnAction
        End If
        If intShapeNumberVal + 1 = lngClaimRemovalHaveWantedClaimsRow Then
            If .Shapes("ToggleBackground" & lngHLSegmentNumberingRow - 1).Fill.ForeColor.RGB = RGB(0, 255, 0) Then Application.Run .Shapes("Toggle" & lngHLSegmentNumberingRow - 1).OnAction
        End If
        If intShapeNumberVal + 1 = lngClaimRemovalHaveUnwantedClaimsRow Then
            If .Shapes("ToggleBackground" & lngHLSegmentNumberingRow - 1).Fill.ForeColor.RGB = RGB(0, 255, 0) Then Application.Run .Shapes("Toggle" & lngHLSegmentNumberingRow - 1).OnAction
        End If
    End With

End Sub

Answer 1

免责声明:我意识到这是一个不太可能的事情......

此错误似乎在不寻常的时间弹出，一个(半)重复出现的解决方案是以尽可能最好的方式处理对象。所以试试这个:

Sub Toggle_ErrorPrevention(ByVal intShapeNumberVal As Integer)

    Dim findRange As Range
    Dim lngHLSegmentNumberingRow As Long
    'more declarations

    Set findRange = ThisWorkbook.Sheets("Correction Type Options").Columns(1).Find(What:="HL Segment Numbering", Lookat:=xlWhole)

    If Not rng Is Nothing Then
        lngHLSegmentNumberingRow = findRange.Row
    End If

    'other code...
End Sub

如果 .Find 没有返回任何内容，您就会得到错误，因为您无法获取 Nothing 的 Row 属性.