應用程序定義或對象定義的錯誤（EXCEL VBA）

Question

我不斷收到一個錯誤1004這條線在我的VBA宏編輯器：

If ActiveCell.Name.Name = "DayShift" Or ActiveCell.Name.Name = "AfterShift" Then 

有誰知道爲什麼嗎？這是我的整個宏：

Private Sub Worksheet_Change(ByVal Target As Range) 

Dim col As Integer 
col = ActiveCell.Column 
Dim bValue As String 
Dim cValue As String 

'Check if cell is required to have both columns with value. 
    'If it is, skip checks. 
    If ActiveCell.Name.Name = "DayShift" Or ActiveCell.Name.Name = "AfterShift" Then 

     End 

    End If 

'Check if active column is column B. 
If ColLetter(col) = "B" Then 

    'Format value of active cell. 
    cValue = "C" + Str(ActiveCell.Row) 
    cValue = Replace(cValue, " ", "") 

    'Check if cell has value. 
    If Range(cValue) = vbNullString Then 

    'If it does, remove the opposite shift. 
    Else 
     MsgBox "This employee has already been assigned for the afternoon shift. In order to allow this change, this employee's scheduling for the afternoon shift will be removed.", vbExclamation 
     Range(cValue).ClearContents 
    End If 

'Check if active column is column C. 
ElseIf ColLetter(col) = "C" Then 

    'Format value of active cell. 
    bValue = "B" + Str(ActiveCell.Row) 
    bValue = Replace(bValue, " ", "") 

    'Check if cell has value. 
    If Range(bValue) = vbNullString Then 

    'If it does, remove the opposite shift. 
    Else 
     MsgBox "This employee has already been assigned for the day shift. In order to allow this change, this employee's scheduling for the day shift will be removed.", vbExclamation 
     Range(bValue).ClearContents 
    End If 

End If 
End Sub 

Function ColLetter(ColNumber As Integer) As String 
    ColLetter = Left(Cells(1, ColNumber).Address(False, False), _ 
     1 - (ColNumber > 26)) 
End Function 

Answer 1

您必須檢查名稱與錯誤處理上。請參閱下面的代碼。我也投入了其他一些改變。

Private Sub Worksheet_Change(ByVal Target As Range) 

    Dim bValue As String 
    Dim cValue As String 
    Dim bIsDayShift As Boolean, bIsAfterShift As Boolean 
    Dim sMsg As String 

    Application.EnableEvents = FALSE 

    sMsg = "This employee has already been assigned for the replaceme shift. " 
    sMsg = sMsg & "In order to allow this change, this employee's scheduling " 
    sMsg = sMsg & "for the replaceme shift will be removed." 

    'Check if cell is required to have both columns with value. 
    'If it is, skip checks. 
    On Error Resume Next 
     bIsDayShift = Target.Name.Name = "DayShift" 
     bIsAfterShift = Target.Name.Name = "AfterShift" 
    On Error GoTo 0 

    If Not bIsDayShift And Not bIsAfterShift Then 
     'Check if active column is column B. 
     If Target.Column = 2 Then 
      If Not IsEmpty(Target.Offset(0, 1).Value) Then 
       MsgBox Replace(sMsg, "replaceme", "afternoon"), vbExclamation 
       Target.Offset(0, 1).ClearContents 
      End If 

     'Check if active column is column C. 
     ElseIf Target.Column = 3 Then 
      If Not IsEmpty(Target.Offset(0, -1).Value) Then 
       MsgBox Replace(sMsg, "replaceme", "day"), vbExclamation 
       Target.Offset(0, -1).ClearContents 
      End If 

     End If 
    End If 

    Application.EnableEvents = TRUE 

End Sub