插入一行时Excel自动化错误

我有一个很大的问题,它使我疯狂。 我有一个非常简单的代码,应该复制一行,并将其添加到活动行的下方,并在代码的开头添加一个validation,以检查是否允许您在该行上添加行。

当你第一次进入工作表时,这个macros很完美。 但是,只要我在表单上的任何单元格中input任何内容,代码就会自动出现错误。 请说有人find了这个,并有一个修复它?

它不喜欢的行如下所示。 Selection.Insert Shift:=xlDown

 Sub Staffing_AddRow() Application.ScreenUpdating = False Application.Calculation = xlCalculationManual ActiveCell.Select Cells(ActiveCell.Row, 223).Select If ActiveCell.Value = "Y" Then ActiveSheet.Unprotect Password:="PasswordGoesHere" '------------------------------------ ActiveCell.Rows("1:1").EntireRow.Select Selection.Copy Selection.Insert Shift:=xlDown '------------------------------------ Cells(ActiveCell.Row, 13).Select ActiveSheet.Protect Password:="PasswordGoesHere" Else If Response = MsgBox("You can't insert a row here!", _ vbCritical, "Warning") Then Cells(ActiveCell.Row, 13).Select End If Cells(ActiveCell.Row, 13).Select End If Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic End Sub 

当它试图粘贴该工作表中的特定行时,我得到Run-time error '-2147417848 (80010108)': Automation error the object invoked has disconnected from its clients

试试这个:使用With ActiveSheet

 Sub Staffing_AddRow() Application.ScreenUpdating = False Application.Calculation = xlCalculationManual ActiveCell.Select 'CHANGES BEGIN HERE With ActiveSheet If .Cells(ActiveCell.row, 223).Value = "Y" Then ActiveSheet.Unprotect Password:="PasswordGoesHere" '------------------------------------ ActiveCell.Rows("1:1").EntireRow.Select Selection.Copy Selection.Insert Shift:=xlDown '------------------------------------ .Cells(ActiveCell.row, 13).Select ActiveSheet.Protect Password:="PasswordGoesHere" Else If Response = MsgBox("You can't insert a row here!", _ vbCritical, "Warning") Then .Cells(ActiveCell.row, 13).Select End If .Cells(ActiveCell.row, 13).Select End If Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic End With End Sub 

另请参阅: 如何避免在macros中使用select语句