Question

我正在编写一个VBA宏，用于在用户单击按钮并通过当前工作簿打开它时保护另一个工作簿。我得到了“应用程序定义或对象定义的错误”。我查看this 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

...然后检查以确保您没有尝试添加重复项。我使用一个小包装器进行测试，以使您的代码更清洁：

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

我添加了某种错误处理和/或让TryAddProtectionRange返回Boolean以获得成功。

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

1 个答案: