ワークシートを保護するときのVBA "アプリケーション定義またはオブジェクト定義のエラー"

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 

私はエラー処理のいくつかの並べ替えを追加したい、および/または成功のためがBooleanを返します。