Excel中的Vbamacros – 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 

行x = r.Validation.Type导致错误1004当我尝试通过拖动dataValdiation范围中的单元格复制。 我正在使用命名的范围。

我看了一下已经打开的问题，但没有find答案。 所有的帮助，非常感谢。

编辑：我试图剪切它，而不是通过拖动复制和粘贴。 对于像我这样的新手来说，先logging一下macros，看看你实际在做什么可能是有用的