复制下拉菜单数据验证时出现“Application-defined or object-defined error”报错

问题场景 #

编写VBA代码将某工作表中的下拉菜单复制到新工作簿的新工作表时，运行代码片段持续触发“Application-defined or object-defined error”，调试发现错误指向If cell.Validation.Type <> xlNone then语句中的cell.Validation.Type，无法通过立即窗口排查问题。

原代码片段：

If Not cell.Validation Is Nothing Then
    If cell.Validation.Type <> xlNone Then
         With cell.Validation
             destSheet.Cells(cell.Row, cell.Column).Validation.Add 'Type:=.Type, _
                  AlertStyle:=.AlertStyle, Operator:=.Operator, Formula1:=.Formula1, Formula2:=.Formula2
             destSheet.Cells(cell.Row, cell.Column).Validation.IgnoreBlank = .IgnoreBlank
             destSheet.Cells(cell.Row, cell.Column).Validation.InCellDropdown = .InCellDropdown
             destSheet.Cells(cell.Row, cell.Column).Validation.ShowInput = .ShowInput
             destSheet.Cells(cell.Row, cell.Column).Validation.ShowError = .ShowError
             destSheet.Cells(cell.Row, cell.Column).Validation.InputTitle = .InputTitle
             destSheet.Cells(cell.Row, cell.Column).Validation.InputMessage = .InputMessage
             destSheet.Cells(cell.Row, cell.Column).Validation.ErrorTitle = .ErrorTitle
             destSheet.Cells(cell.Row, cell.Column).Validation.ErrorMessage = .ErrorMessage
             destSheet.Cells(cell.Row, cell.Column).Validation.ErrorStyle = .ErrorStyle
         End With
    End If
End If

问题原因 #

1. 核心参数缺失：原代码中Validation.Add方法的核心参数（Type:=.Type）被注释，导致Add方法无法正常执行，后续访问验证属性时触发错误。
2. 未处理验证对象异常：直接访问cell.Validation.Type时，若源单元格的验证规则存在但处于异常状态（如公式引用无效、合并单元格验证），会触发对象定义错误。
3. 目标单元格未清理：目标单元格可能已有无效验证规则，与新添加的规则冲突。

修复后的代码 #

Dim srcCell As Range
Dim destCell As Range
Dim validationType As XlDVType

' 替换为你的源单元格和目标工作表对象
Set srcCell = ThisWorkbook.Sheets("源工作表").Range("A1") ' 示例源单元格
Set destCell = NewWorkbook.Sheets("目标工作表").Cells(srcCell.Row, srcCell.Column)

' 先清除目标单元格已有验证，避免冲突
On Error Resume Next
destCell.Validation.Delete
On Error GoTo 0

If Not srcCell.Validation Is Nothing Then
    ' 捕获Type访问可能的异常
    On Error Resume Next
    validationType = srcCell.Validation.Type
    On Error GoTo 0
    
    If validationType <> xlNone Then
        With srcCell.Validation
            ' 完整传递Add方法的所有必要参数
            destCell.Validation.Add Type:=.Type, _
                                   AlertStyle:=.AlertStyle, _
                                   Operator:=.Operator, _
                                   Formula1:=.Formula1, _
                                   Formula2:=.Formula2
            ' 批量复制验证属性
            destCell.Validation.IgnoreBlank = .IgnoreBlank
            destCell.Validation.InCellDropdown = .InCellDropdown
            destCell.Validation.ShowInput = .ShowInput
            destCell.Validation.ShowError = .ShowError
            destCell.Validation.InputTitle = .InputTitle
            destCell.Validation.InputMessage = .InputMessage
            destCell.Validation.ErrorTitle = .ErrorTitle
            destCell.Validation.ErrorMessage = .ErrorMessage
            destCell.Validation.ErrorStyle = .ErrorStyle
        End With
    End If
End If

关键修复点 #

• 取消Validation.Add的参数注释，确保传递Type等核心参数，这是解决报错的首要条件。
• 增加错误捕获逻辑处理Validation.Type的访问，避免因源验证规则异常导致崩溃。
• 提前清除目标单元格的已有验证，防止规则冲突。
• 明确变量命名（如srcCell、destCell），避免模糊的cell引用引发对象无效问题。

内容的提问来源于stack exchange，提问作者Jonathan Freels