VBA“应用程序定义或对象定义的错误”，当保护工作表

我正在写一个VBAmacros，保护另一个工作簿，当用户点击一个button，并通过当前工作簿打开它。 我得到了“应用程序定义或对象定义的错误”。 我看着这个post ，确保需要打开的工作簿不受保护。 但错误仍然发生。 请帮忙。 谢谢！

Sub LockModelParInput() Dim wbk As Workbook Workbooks.Open (ModelParVarClusLocalPath & "\" & ProN & "_ModelParameter_UserInput.xlsx") Set wbk = Workbooks(ProN & "_ModelParameter_UserInput.xlsx") wbk.Activate With ActiveWorkbook.Worksheets("Model_Rule") .Protection.AllowEditRanges.Add Title:="VIF Cut Off Level 2", _ Range:=Range("C4") *'error occurs on this line* .Protection.AllowEditRanges.Add Title:="p_value stay", Range:= _ Range("D4") .Protection.AllowEditRanges.Add Title:="Trend Threshold", Range _ :=Range("E4") .Protection.AllowEditRanges.Add Title:="r_var_ks_penalize", Range _ :=Range("B10") .Protection.AllowEditRanges.Add Title:="fast backward", Range:= _ Range("C16") .Protection.AllowEditRanges.Add Title:="locked forward", Range:= _ Range("C17") .Protection.AllowEditRanges.Add Title:="enhanced stepwise", Range _ :=Range("C18") .Protection.AllowEditRanges.Add Title:="traditional backward", _ Range:=Range("C19") .Protection.AllowEditRanges.Add Title:="sas stepwise", Range:= _ Range("C21") .Protect DrawingObjects:=True, Contents:=True, Scenarios:=True End With End Sub 

Answer 1

您需要检查编辑范围的标题是否已被使用 – 它们不能被复制。 只要敲一个这样的快速函数来迭代它们：

 Private Function EditRangeExists(Sh As Worksheet, Title As String) As Boolean With Sh.Protection Dim found As AllowEditRange For Each found In .AllowEditRanges If found.Title = Title Then EditRangeExists = True Exit Function End If Next End With End Function 

…然后检查以确保您不试图添加重复项。 我会使用一个小的包装testing，使您的代码更清洁：

 Private Sub TryAddProtectionRange(Title As String, Target As Range) With Target If EditRangeExists(Target.Parent, Title) Then Exit Sub End If .Parent.Protection.AllowEditRanges.Add Title, Target End With End Sub 

那么你可以像这样使用它：

 Sub LockModelParInput() Dim wbk As Workbook Set wbk = Workbooks.Open(ModelParVarClusLocalPath & "\" & ProN & _ "_ModelParameter_UserInput.xlsx") Dim Sh As Worksheet Set Sh = wbk.Worksheets("Model_Rule") With Sh TryAddProtectionRange "VIF Cut Off Level 2", .Range("C4") TryAddProtectionRange "p_value stay", .Range("D4") 'Etc. .Protect DrawingObjects:=True, Contents:=True, Scenarios:=True End With End Sub 

我会添加一些error handling和/或TryAddProtectionRange返回一个Boolean成功也。