Question

我弄明白尼克的建议是什么，以下是错误编号＆amp;我得到的描述：

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

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

.Rows（Lst）.Insert Shift：= xlDown

我以为我在这个或另一个论坛的某个地方看到要取消注册然后重新注册一个特定文件，但是当我遇到它时我就在家里，并且不想在我的笔记本电脑上试用它，因为一切已经100％正常工作。

再一次，非常感谢任何帮助。我星期天离开了两个星期，在离开前我真的需要让它工作。大多数为我工作的人都不是优秀大师，需要所有按钮/功能都能正常工作，因为他们无法排除故障和/或解决问题。

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

 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个月了，我终于解决了这个问题！幸运的是＆amp;不幸的是，它与我的代码完全无关。相反，它是一个MS Office Vs. Windows 8问题。为了解决这个问题，我运行了兼容性故障排除程序，所有这些都又恢复了完美：

打开MS Excel（任何文件或新文件）
拉起任务管理器
单击后台进程中的MS Office或Excel图标，右键单击，然后选择属性
在兼容性下，点击＆＃34;运行兼容性问题排查工具＆＃34;
完成运行后，再次测试文件，如果工作正常，请单击“将设置应用于此程序”。如果它不起作用，请单击“下一步”并从选项中进行选择。（我选择它在以前版本的Windows（Windows 7）中工作然后再次单击“下一步”。
再次测试文件，它有效。

我无法相信这是我一直以来所做的一切！我实际花了149美元，认为Microsoft支持可以远程控制并修复它，但这绝对是浪费！我被转移到12个不同的人/部门，但仍然没有从他们那里得到任何东西。我今天早上偶然发现了解决方案......

无论如何，感谢所有发布并试图帮助我的人。因为你们所有人，我总是以比我签约的更好的VBA技能注销这个网站...所以再次感谢！

Answer 2

此解决方案对我有用：

在使用Shift：= xlDown添加行之前，删除工作表中的底部行

'ADD THE ROWS YOU WANT

Sheets("XXXXXX").Range("A100000:A100100").EntireRow.Delete

With Selection
.Copy
.Insert Shift:=xlDown
End With

Answer 3

确保插入时未锁定单元格来保护工作表。这可能是代码将失败的原因之一。这段代码在一个文件夹上对我有用，但是当我将excel宏文件复制到另一个文件夹时，我开始收到此错误。由于它仅用于格式化，因此我完全避免使用以下代码，而是以通常的方式进行了格式化，而不是从上面的行进行复制。请注意，在第一个代码中，整个行都被选中，并且如果您具有受保护的单元格，则可能导致失败。
'行（r + 3＆“：”＆r + 3）。选择 '选择插入Shift：= xlDown，CopyOrigin：= xlFormatFromLeftOrAbove

Answer 4

我遇到了同样的问题，有些宏适用于所有人，但不适用于1个人。

我通过要求此人不要使用已同步到OneDrive的文件夹来解决此问题，因此在使用OneDrive时要小心。

在其他情况下，OneDrive将从BOX或其他文件共享服务下载的文件标记为只读，并导致宏错误。您所需要做的就是打开文件，保存并再次打开它，但是有人指责它在我的宏上。我花了一段时间才找到原因，并找到了一种在宏实际打开之前使用宏保存重新打开文件的方法...

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

4 个答案: