With 语句产生运行时错误 438

Question

我明白了

运行时错误“438”
“对象不支持此属性或方法。”

我使用的代码激活了另一个工作簿（Changes_Database Workbook），然后（在 Changes_Database Workbook 中有一个名为 Changes 的工作表>) 代码插入一行并将其他行向下移动，复制下面单元格的格式，然后在日期和时间旁边输入键、部件和流程名称（基本上是描述，不重要）。

下面的代码很慢：

Sub NewPart2()

'Sets Changes_Database as active contents and unprotects

    Set Cd = Workbooks.Open(Filename:="\\FILEPATH\Technology_Changes\Changes_Database_IRR_200-2S_New.xlsm", Password:="Swarf")
    Set Changes = Cd.Sheets("Changes")

Changes.Activate
ActiveSheet.Unprotect "Swarf"

'Selects the 2nd row of the database, which is the row after the headings
ActiveSheet.Rows("2:2").Select

'Inserts a new row and shifts the other rows down
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrBelow

'Inputs the key that is being added to the new row
ActiveSheet.Range("A2").Value = Sheet1.Range("H4").Value

'Inputs the part and process name to the new row
ActiveSheet.Range("D2").Value = UCase(Sheet1.Range("E4").Value)
ActiveSheet.Range("E2").Value = Sheet1.Range("E5").Value

'Inputs the date and time for when it was added
ActiveSheet.Range("B2").Value = Now
ActiveSheet.Range("C2").Value = Now
ActiveSheet.Range("C2").NumberFormat = "h:mm:ss AM/PM"
ActiveSheet.Range("B2").NumberFormat = "dd/mm/yyyy"

'On Error Resume Next

            ActiveSheet.Protect "Swarf"
            ActiveWorkbook.Save
            ActiveWorkbook.Close SaveChanges:=True

On Error Resume Next

End Sub

激活另一张工作表需要很长时间才能使该模块执行其功能，因此我尝试了 With 语句，但出现了该错误。

我正在尝试用我的第二个代码提高此代码的速度：（两个代码的屏幕截图也可以在下面找到）

Sub NewPart2()

Application.ScreenUpdating = False

Set y = Workbooks.Open(Filename:="\\FILEPATH\Technology_Changes\Changes_Database_IRR_200-2S_New.xlsm", Password:="Swarf")

    With y

      Sheets("Changes").Unprotect "Swarf"

        .Sheets("Changes").Rows("2:2").Select
        'Inserts a new row and shifts the other rows down
        .Sheets("Changes").Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrBelow

        'Inputs the key that is being added to the new row
        .Sheets("Changes").Range("A2").Value = Sheet1.Range("H4").Value

        'Inputs the part and process name to the new row
        .Sheets("Changes").Range("D2").Value = UCase(Sheet1.Range("E4").Value)
        .Sheets("Changes").Range("E2").Value = Sheet1.Range("E5").Value

        'Inputs the date and time for when it was added
        .Sheets("Changes").Range("B2").Value = Now
        .Sheets("Changes").Range("C2").Value = Now
        .Sheets("Changes").Range("C2").NumberFormat = "h:mm:ss AM/PM"
        .Sheets("Changes").Range("B2").NumberFormat = "dd/mm/yyyy"

      Password = "Swarf"

        .Save
        .Close False

    End With

Application.ScreenUpdating = True

End Sub

Answer 1

不要使用（或尝试使用）Selection。 Worksheet 或 Sheet 没有 Selection 属性。

改变

.Sheets("Changes").Rows("2:2").Select
'Inserts a new row and shifts the other rows down
.Sheets("Changes").Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrBelow

到

.Sheets("Changes").Rows("2:2").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrBelow

---

旁注，您使用 Sheets("Changes") 的频率如此之高，以至于您可以将其与您的 With...End With 一起使用并节省大量输入。

Set y = Workbooks.Open(Filename:="\\FILEPATH\Technology_Changes\Changes_Database_IRR_200-2S_New.xlsm", Password:="Swarf")

With y.Sheets("Changes")
    .Rows("2:2").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrBelow
    ' and so on
End With

y.Save
y.Close False

非常重要：通过预先添加句点.，确保您在With...End With 中符合Rows 和Range 调用。