应用程序定义或对象定义的错误(Excel VBA)

时间:2022-11-05 14:26:13

I keep getting an error 1004 for this line in my VBA Macro Editor:

我在VBA宏编辑器中不断收到错误1004:

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

Does anyone know why? This is my whole 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

1 个解决方案

#1


2  

You have to check for the Name with error handling on. See the code below. I threw in a few other changes too.

您必须检查具有错误处理的名称。请参阅下面的代码。我也提出了一些其他的改变。

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

#1


2  

You have to check for the Name with error handling on. See the code below. I threw in a few other changes too.

您必须检查具有错误处理的名称。请参阅下面的代码。我也提出了一些其他的改变。

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