Excel VBA“自动化错误：调用的对象已与其客户端断开连接”

Question

我了解了尼克的建议，以下是我得到的错误号和说明：

'-2147417848（80010108）'自动化错误调用的对象已与其客户端断开连接

我调试时突出显示的代码行是：

.Rows（Lst）。插入移位：= xlDown

我以为我曾在该论坛或其他论坛上看到某个地方要注销，然后重新注册特定文件，但是当我遇到该文件时，我就在家里，不想在笔记本电脑上尝试它，因为一切都可以正常工作100 ％ 在上面。

再次感谢您的帮助。我要在星期天离开2周，我真的需要在离开之前进行这项工作。为我工作的大多数人都不是excel大师，他们需要所有按钮/功能才能正常工作，因为他们将无法解决和/或解决问题。

我仍然在常规模块中坐在下面的代码中，而下面的下一组代码在一个工作表模块中。

 Sub add_InvRow()
 Application.Calculation = xlCalculationManual
 Application.EnableEvents = False

 switch = "off"

 With ThisWorkbook
  Dim wb As Excel.Workbook, Lst As Long
  Set wb = Application.ThisWorkbook
Dim ws As Worksheet, sw As Worksheet, os As Worksheet
   Set ws = ActiveSheet: Set sw = Application.Sheets(Sheet1.Name): Set os = Application.Sheets(Sheet4.Name)

  With ws
  Lst = ActiveCell.Row
  End With

   If ws.CodeName = "Sheet3" Then

  With os
   .Rows(213).Copy
  End With

  With ws


   .Rows(Lst).Insert Shift:=xlDown
   Application.CutCopyMode = False

    venTabForm.Show
  End With
End If

If ws.CodeName = "Sheet23" Then

  With sw
   .Rows(135).Copy
  End With

  With ws

   .Rows(Lst).Insert Shift:=xlDown
   Application.CutCopyMode = False

    cItemForm.Show
  End With
End If

 If ws.CodeName = "Sheet25" Then

 With sw
   .Rows(105).Copy
  End With

  With ws

   .Rows(Lst).Insert Shift:=xlDown
   Application.CutCopyMode = False

   coInvForm.Show
  End With
 End If

 If ws.CodeName = "Sheet28" Then

  With sw
   .Rows(100).Copy
  End With

  With ws

   .Rows(Lst).Insert Shift:=xlDown
   Application.CutCopyMode = False

   kInvForm.Show
  End With
End If

If ws.CodeName = "Sheet27" Then

  With sw
   .Rows(130).Copy
  End With

  With ws
     .Rows(Lst).Insert Shift:=xlDown
     Application.CutCopyMode = False

     ItemForm.Show
  End With
End If

If ws.CodeName = "Sheet22" Then

  With sw
   .Rows(120).Copy
  End With

  With ws

   .Rows(Lst).Insert Shift:=xlDown
   Application.CutCopyMode = False

    caInvForm.Show
  End With
End If

 Set ws = Nothing: Set sw = Nothing: Set os = Nothing: Set wb = Nothing
End With

 switch = "on"
 Application.EnableEvents = True
 Application.Calculation = xlCalculationAutomatic
End Sub

此代码在具有命令按钮的工作表之一上，该命令按钮调用上述代码。

 Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If switch = "off" Then Exit Sub
 If Target.Address = "$H$1" Then
  Call findItem
 Exit Sub
 End If


If Application.Intersect(Target, Me.Range("P:P")) Is Nothing Or Target.Cells.Count > 1 Then Exit Sub
If Target.Cells.Value = 0 Or Target.Cells.Value = "" Then Exit Sub
Dim wb As Workbook, ws As Worksheet, iNUM As String, kitSHT As Worksheet, ksRNG As Range, kITEM As Range, kbCELL As Range
Dim iNAME As String, catSHT As Worksheet, csRNG As Range, cbCELL As Range, cITEM As Range
Dim logCELL As Range



Set wb = ThisWorkbook: Set ws = wb.Sheets(Sheet27.Name): Set kitSHT = wb.Sheets(Sheet28.Name): Set catSHT = wb.Sheets(Sheet22.Name)
Set ksRNG = kitSHT.Range("C5:C1100"): Set kbCELL = ksRNG.Cells(5, 3)
Set csRNG = catSHT.Range("C6:C400"): Set cbCELL = csRNG.Cells(6, 3)


 If (Not (Application.Intersect(Target, Me.Range("A:P")) Is Nothing)) And (Target.Cells.Count = 1) And (Target.Column = 16) Then
  If Target.Value = 0 Then Exit Sub
   iNUM = Target.Offset(, -12).Value
   iNAME = Target.Offset(, -10).Value

   If kitSHT.Cells.Find(What:=iNUM, After:=kbCELL, LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False) Is Nothing And _
  catSHT.Cells.Find(What:=iNUM, After:=cbCELL, LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False) Is Nothing Then



    MsgBox iNUM & "-" & iNAME & "" & " is not currently listed on" & " " & kitSHT.Name & " " & "or" & " " & catSHT.Name & vbNewLine & vbNewLine & _
              "Please add" & " " & iNUM & "-" & iNAME & "" & " to" & " " & kitSHT.Name & " " & _
               "or" & " " & catSHT.Name & " " & "and corresponding count sheets", vbInformation

  Set wb = Nothing: Set ws = Nothing: Set kbCELL = Nothing
  Set ksRNG = Nothing: Set kitSHT = Nothing: Set cbCELL = Nothing: Set catSHT = Nothing: Set csRNG = Nothing
  Exit Sub
 Else
If Target.Value = 0 Then Exit Sub
  premNUM = iNUM


 pFORM.Show
 End If
 End If

  Set wb = Nothing: Set ws = Nothing: Set kbCELL = Nothing
  Set ksRNG = Nothing: Set kitSHT = Nothing: Set cbCELL = Nothing: Set catSHT = Nothing: Set csRNG = Nothing


  Set ksRNG = Nothing: Set kitSHT = Nothing: Set cbCELL = Nothing: Set catSHT = Nothing: Set csRNG = Nothing
End Sub

Answer 1

好的...已经过去1个月了，我终于解决了这个问题！幸运的是，不幸的是，它与我的代码完全无关。相反，它是MS OfficeVs。Windows 8问题。要解决此问题，我运行了兼容性疑难解答程序，一切都又恢复了完美：

1. 打开MS Excel（任何文件或新文件）
2. 上拉任务管理器
3. 在后台进程中单击MS Office或Excel图标，右键单击，然后选择属性
4. 在兼容性下，单击“运行兼容性疑难解答”
5. 完成运行后，再次测试文件，如果可以正常运行，请单击“将设置应用于此程序”。如果不起作用，请单击下一步，然后从选项中进行选择。（我选择它可以在Windows的早期版本（Windows 7）中运行，然后再次单击“下一步”。
6. 再次测试文件，它起作用了。

我不敢相信这就是我一整天要做的一切！我实际上花了149美元，以为Microsoft支持可以远程修复它，但这绝对是浪费！我被转移到12个以上的不同人员/部门，但他们一无所获。我终于在今天早上偶然发现了解决方案。

无论如何，感谢所有发布并尝试帮助我的人。由于所有人，我总是以比登录时还更好的VBA技能注销该站点。再次感谢！