Excel中的Vba宏-Range.Validation.Type导致1004

我试图防止粘贴到Excel中的下拉列表上。我提出的代码如下：

Private Sub Worksheet_Change(ByVal Target As Range)
    Application.EnableEvents = False
    'turn off events so this routine is not continuously fired

    Set BoroughTrainingTookPlaceIn = Range("BoroughTrainingTookPlaceIn")
    Set StartTimeOfSession = Range("StartTimeOfSession")
    Set TypeOfSession = Range("TypeOfSession")
    Set BikeabilityLevelRatingBeforeTraining = Range("BikeabilityLevelRatingBeforeTraining")
    Set BikeabilityLevelRatingAfterTraining = Range("BikeabilityLevelRatingAfterTraining")


    If RangesIntersect(Target, BoroughTrainingTookPlaceIn) Then
        PreventPaste (BoroughTrainingTookPlaceIn)
    ElseIf RangesIntersect(Target, StartTimeOfSession) Then
        PreventPaste (StartTimeOfSession)
    ElseIf RangesIntersect(Target, TypeOfSession) Then
        PreventPaste (TypeOfSession)
    ElseIf RangesIntersect(Target, BikeabilityLevelRatingBeforeTraining) Then
        PreventPaste (BikeabilityLevelRatingBeforeTraining)
    ElseIf RangesIntersect(Target, BikeabilityLevelRatingAfterTraining) Then
        PreventPaste (BikeabilityLevelRatingAfterTraining)
    End If

    Application.EnableEvents = True
End Sub
Private Function HasValidation(r) As Boolean
'   Returns True if every cell in Range r uses Data Validation
    On Error Resume Next
    x = r.Validation.Type
    If Err.Number = 0 Then HasValidation = True Else HasValidation = False
End Function
 Function RangesIntersect(ByVal Range1 As Range, ByVal Range2 As Range) As Variant
    Dim intersectRange As Range
    Set intersectRange = Application.Intersect(Range1, Range2)
    If intersectRange Is Nothing Then
        RangesIntersect = False
    Else
        RangesIntersect = True
    End If
End Function
 Private Function PreventPaste(ByVal Target As Range) As Variant
    If Not HasValidation(Target) Then
        Application.Undo
        MsgBox "Invalid value. Please chose a value from the dropdown"
    End If
End Function

当我试图通过拖动DataValidation范围中的单元格进行复制时，行

x=r.Validation.Type

导致错误1004。我正在使用命名范围

我仔细查看了已经打开的问题，但没有找到答案。非常感谢您的帮助

编辑：

---

我试图剪切它，而不是通过拖动来复制和粘贴它。对于像我这样的新手来说，首先记录宏并查看您实际在做什么可能很有用

如何调用

preventplaste

？可能是由工作表的一个事件程序触发的。你能把代码也包括进去吗？什么是

r

？如果是

范围

则需要在函数的参数中指定该范围，例如

hasvalization（r as Range）

如果您没有提供PreventPaste的用法，则很难知道该范围中的内容。我的假设是，它被设计成一个单细胞功能，你试图通过一系列细胞。尝试为target.cells中的每个单元格添加一个

，将循环添加到PreventPaste函数中。此外，这里还有一些其他的危险信号，在下一次错误恢复时使用
，
，不会恢复正常，x也不会变暗。@David Zemens-我更新了queston@Jordan Yes，我想出来了-我添加了它，但没有更改在错误恢复下一步中使用
肯定会阻止1004在这种情况下上升（如果
r
没有指定验证，则会发生这种情况）。我无法复制此错误。如何调用
preventplaste
？可能是由工作表的一个事件程序触发的。你能把代码也包括进去吗？什么是
r
？如果是
范围
则需要在函数的参数中指定该范围，例如
hasvalization（r as Range）
如果您没有提供PreventPaste的用法，则很难知道该范围中的内容。我的假设是，它被设计成一个单细胞功能，你试图通过一系列细胞。尝试为target.cells中的每个单元格添加一个
，将循环添加到PreventPaste函数中。此外，这里还有一些其他的危险信号，在下一次错误恢复时使用
，
，不会恢复正常，x也不会变暗。@David Zemens-我更新了queston@Jordan Yes，我想出来了-我添加了它，但没有更改在错误恢复下一步中使用
肯定会阻止1004在这种情况下上升（如果
r
没有指定验证，则会发生这种情况）。我无法复制此错误。