Définie par application ou erreur définie par l'objet (Excel VBA)

Question

Je continue à obtenir une erreur 1004 pour cette ligne dans mon VBA Macro Editor:

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

Est-ce que quelqu'un sait pourquoi? Ceci est toute ma macro:

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

Vous devez vérifier le nom avec la gestion des erreurs. Voir le code ci-dessous. J'ai jeté quelques autres changements aussi.

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