Excel VBA“自动化错误：被调用的对象已经与其客户端断开连接” [英] Excel VBA "Automation Error: Object Invoked has disconnected from its clients"

问题描述

我想出了尼克提出的建议，以下是错误编号&描述我得到：

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

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

.Rows（Lst）.Insert Shift：= xlDown

我以为我看过这个或另一个论坛的某个地方要注销，然后重新注册一个特定的文件，但是当我遇到这个问题的时候我在家，而且没有不想在我的笔记本电脑上尝试，因为一切都已经在100％上了。

再次感谢任何帮助。我离开星期天2个星期，我真的需要在离开之前让它工作。为我工作的大多数人不是优秀的大师，需要所有的按钮/功能工作，因为他们将无法解决问题和/或解决问题。

我仍然坐在常规模块中使用以下代码，下面的一组代码位于其中一个工作表模块中。

  Sub add_InvRow（）
 Application.Calculation = xlCalculationManual 
 Application.EnableEvents = False 
 
 switch = off
 
 With ThisWorkbook 
 Dim wb As Excel.Workbook，Lst As Long 
设置wb = Application.ThisWorkbook 
 Dim ws As Worksheet，sw As Worksheet， os As Worksheet 
设置ws = ActiveSheet：设置sw = Application.Sheets（Sheet1.Name）：设置os = Application.Sheets（Sheet4.Name）
 
与ws 
 Lst = ActiveCell.Row 
结束
 
如果ws.CodeName =Sheet3然后
 
与os 
 .Rows（213）.Copy 
结束
 
与ws 
 
 
 .Rows（Lst）.Insert Shift：= xlDown 
 Application.CutCopyMode = False 
 
 venTabForm.Show 
结束
结束如果
 
如果ws.CodeName =Sheet23然后
 
与$ SW 
 .Rows（135）.Copy 
结束
 
与ws 
 
 .Rows（Lst）.Insert Shift：= xlDown 
 Application.CutCopyMode = False 
 
 cItemForm.Show 
结束
结束如果
 
如果ws.CodeName =Sheet25然后
 
与sw 
 .Rows（105）.Copy 
结束与
 
与ws 
 
 .Rows（Lst）。插入Shift：= xlDown 
 Application.CutCopyMode = False 
 
 coInvForm.Show 
 End with 
 End If 
 
如果ws.CodeName = Sheet28然后
 
与sw 
 .Rows（100）.Copy 
结束
 
与ws 
 
。 Rows（Lst）.Insert Shift：= xlDown 
 Application.CutCopyMode = False 
 
 kInvForm.Show 
 End with 
 End If 
 
如果ws.CodeName =Sheet27然后
 
与sw 
 .Rows（130）.Copy 
结束与
 
与ws 
 .Rows（Lst）.Insert Shift：= xlDown 
 Application.CutCopyMode = False 
 
 ItemForm.Show 
结束
结束如果
 
如果ws.CodeName =Sheet22然后
 
与sw 
 .Rows（120）.Copy 
结束与
 
与ws 
 
 .Rows（Lst）.Insert Shift：= xlDown 
 Application.CutCopyMode = False 
 
 caInvForm。显示
结束
结束如果
 
设置ws =没有：设置sw =无：设置os =无：设置wb =没有
结束
 
 switch =on
 Application.EnableEvents = True 
 Application.Calculation = xlCalculationAutomatic 
 End Sub 
  

此代码位于其中一个工作表上，其中有一个命令按钮，调用上述代码。

  Private Sub Worksheet_Change（ByVal Target As Range）
如果Target.Cells.Count> 1然后退出Sub 
如果switch =off则退出Sub 
如果Target.Address =$ H $ 1然后
调用findItem 
 Exit Sub 
 End If 
 
 
如果Application.Intersect（Target，Me.Range（P：P））是Nothing或Target.Cells.Count> 1然后退出Sub 
如果Target.Cells.Value = 0或Target.Cells.Value =然后退出Sub 
 Dim wb As Workbook，ws As Worksheet，iNUM As String，kitSHT As Worksheet，ksRNG作为范围，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 
 
 
 
设置wb = ThisWorkbook：设置ws = wb.Sheets（Sheet27.Name）：设置kitSHT = wb.Sheets（Sheet28.Name）：设置catSHT = wb.Sheets（Sheet22.Name）
设置ksRNG = kitSHT.Range（C5：C1100）：设置kbCELL = ksRNG.Cells（5，3）
设置csRNG = catSHT.Range（C6：C400）：设置cbCELL = csRNG。单元格（6,3）
 
 
如果（Not（Application.Intersect（Target，Me.Range（A：P））没有））和（Target.Cells.Count = 1）And（Target.Column = 16）然后
如果Target.Value = 0然后退出Sub 
 iNUM = Target.Offset（，-12）.Value 
 iNAME = Target.Offset （，-10）.Value 
 
如果kitSHT.Cells.Find（What：= iNUM，After：= kbCELL，LookIn：= xlValues，LookAt：= _ 
 xlPart，SearchOrder：= xlByRows，SearchDirection：= xlNext，MatchCase：= False，SearchFormat：= False）没有和_ 
 catSHT.Cells.Find（什么：= iNUM，After：= cbCELL， LookIn：= xlValues，LookAt：= _ 
 xlPart，SearchOrder：= xlByRows，SearchDirection：= xlNext，MatchCase：= False，SearchFormat：= False）否是
 
 
 
 MsgBox iNUM&  - & iNAME& & 目前尚未列入& & kitSHT.Name& & 或& & catSHT.Name& vbNewLine& vbNewLine& _ 
请添加& & iNUM&  - & iNAME& & 到& & kitSHT.Name& & _ 
或& & catSHT.Name& & 和相应的计数表，vbInformation 
 
设置wb = Nothing：Set ws = Nothing：Set kbCELL = Nothing 
 Set ksRNG = Nothing：Set kitSHT = Nothing：Set cbCELL = Nothing：Set catSHT = Nothing：Set csRNG = Nothing 
退出Sub 
 Else 
如果Target.Value = 0然后退出Sub 
 premNUM = iNUM 
 
 
 pFORM.Show 
 End If 
 End If 
 
 Set wb = Nothing：Set ws = Nothing：Set kbCELL = Nothing 
 Set ksRNG = Nothing：Set kitSHT =没有什么：Set cbCELL = Nothing：Set catSHT = Nothing：Set csRNG = Nothing 
 
 
 Set ksRNG = Nothing：Set kitSHT = Nothing：Set cbCELL = Nothing：Set catSHT = Nothing：Set csRNG =没有
结束Sub 
  

解决方案

现在已经有一个多月了，我终于修复了！幸运的不幸的是，它与我的代码绝对无关。相反，它是一个MS办公室。 Windows 8问题。为了解决这个问题，我运行了兼容性问题排查器，所有这些都恢复了完美：

1. 打开MS Excel（任何文件或新文件）


2. 拉上任务管理器


3. 单击后台进程中的MS Office或Excel图标，右键单击并选择属性


4. 在兼容性下，单击运行兼容性问题排查程序


5. 完成运行后，再次测试文件，如果正确，请单击应用设置到此程序。如果不起作用，请单击下一步并从选项中进行选择。 （我选择它在以前版本的Windows（Windows 7）中工作，然后再次单击下一步。


6. 再次测试文件，并且它的工作。

我不能相信这是我一直在做的一切！我实际上花了149美元认为，微软支持可以远程和修复它，但这是一个绝对的浪费！被转移到了12个不同的人/部门，仍然没有任何东西，我今天早上终于遇到了解决方案。

无论如何，感谢大家发布并试图帮助我这个，我总是退出这个网站与更好的VBA技能比我签署，因为所有你...所以再次感谢

I figured out what Nick was suggesting, and the following is the error number & description that I'm getting:

'-2147417848 (80010108)' Automation error The object invoked has disconnected from its clients

The line of code that is highlighted when I debug is:

.Rows(Lst).Insert Shift:=xlDown

I thought that I had seen somewhere on this or another forum to unregister then re-register a specific file, but I was at home when I came across that, and didn't want to try it on my laptop, since everything already works 100% on it.

Once again, any help is greatly appreciated. I leave Sunday for 2 weeks, and I really need to get this working before I leave. Most of the people working for me are not excel guru's and need all buttons/functions working, as they won't be able to troubleshoot and/or work around the problems.

I am still sitting with the following code in a regular module, and the next set of code below that is in one of the worksheet modules.

 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

This code is on one of the worksheets that has a command button, which calls the above code.

 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

解决方案

Ok... It's been well over 1 month now, and I've finally fixed this!! Fortunately & Unfortunately, it had absolutely nothing to do with my code. Instead, it was an MS Office Vs. Windows 8 problem. To fix it, I ran the compatability troubleshooter, and all is back to perfect again:

1. Open MS Excel (Any File or new file)
2. Pull up Task Manager
3. Click on MS Office or Excel Icon in Background Processes, Right click, and select properties
4. Under Compatibility, Click "Run Compatibility Troubleshooter"
5. When finished running, test file again, if it works right, click apply settings to this program. If it doesn't work, click next and choose from the options. (I chose that it worked in previous version of Windows (Windows 7) Then click Next again.
6. Test file again, and it worked.

I cannot believe that this is all I had to do the whole time! I actually spent $149 thinking that Microsoft Support could remote in and fix it, but that was an absolute waste! I was transferred to 12+ different people/departments, and still got nothing from them. I finally stumbled across the solution this morning....

Anyway, thanks to everyone who posted and tried to help me with this. I always log off of this site with better VBA skills than I signed on with because of all of you... So Thanks again!

这篇关于Excel VBA“自动化错误：被调用的对象已经与其客户端断开连接”的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！