With 语句产生运行-Time Error 438

Question

我明白了

Run-time error '438'
"Object doesn't support this property or method."

我使用的代码激活了 另一个工作簿（Changes_Database 工作簿），然后（在 Changes_Database 工作簿中有一个 sheet 称为 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

激活另一个 sheet 这个模块需要很长时间才能执行它的功能，所以我尝试了 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 调用事先.

With 语句产生运行-Time Error 438

With statement produces Run-Time Error 438

excel

vba

runtime-error

with-statement

With 语句产生 运行-Time Error 438

With statement produces Run-Time Error 438

excel

vba

runtime-error

with-statement

With 语句产生运行-Time Error 438