電子表格被保護時Excel VBA驗證錯誤

Question

我試圖確保輸入到Excel電子表格命名範圍內的數據是有效的。爲此，我已經爲範圍中的列「A」定義了一個靜態驗證列表，併爲該列啓用了下拉列表。根據用戶選擇的選項，我在運行時在列「B」中添加了一個驗證對象，列表中列入了列「A」中條目的約束條目。根據列A和B中的條目，列「C」中的單元格被自動填充。

這項工作正常，直到電子表格保護啓用。此時，試圖從列「B」中的下拉列表中選擇一個選項將生成以下錯誤：

「您試圖更改的單元格或圖表受保護，因此爲只讀...」

然而

• 在所討論的範圍內的所有細胞之前將工作表 保護被解鎖。
• 代碼在更新列「B」中的驗證對象之前明確刪除保護，然後在添加驗證對象 後替換驗證對象。
• 當從列「B」中的下拉列表中選擇列表項目時， 錯誤消息在任何工作表事件發生之前立即觸發， 使得無法捕獲或調試錯誤。

我在電子表格和單獨的代碼模塊中都有代碼，兩者都包含在下面。任何想法，將不勝感激

這裏是在Worksheet_Change（）事件中的代碼：

Private Sub Worksheet_Change(ByVal Target As Range) 
    Dim strNm As String 

    ' there will be multiple named ranges eventually. We need to be able to distinguish 
    ' among the various ranges so that our code executes only against the data we expect 
    ' to manipulate - not random cells 
    If Not Intersect(ActiveCell, ActiveWorkbook.Names("DBAddRange").RefersToRange) Is Nothing Then 
    Dim rng As Range 

    Set rng = ActiveWorkbook.Names("DBAddRange").RefersToRange 

    If Target.Column = 1 Then 
     If FLAG_CHANGE_IN_PROGRESS = True Then Exit Sub 
     FLAG_CHANGE_IN_PROGRESS = True 
     Dim VldnList As String 

     VldnList = getVldtnList(Target.Value) 

     unlockSS ActiveSheet 
     Range("B" & Target.row).Clear 
     Range("B" & Target.row).Select 
     With Range("B" & Target.row).Validation 
      .Delete 
      .Add Type:=xlValidateList, Operator:=xlValidateList, Formula1:=VldnList 
      .IgnoreBlank = False 
      .InCellDropdown = True 
     End With 

     lockSS ActiveSheet 
     Range("B" & Target.row).Select 
     FLAG_CHANGE_IN_PROGRESS = False 
    ElseIf Target.Column = 2 Then 
     If FLAG_CHANGE_IN_PROGRESS = True Then Exit Sub 
      FLAG_CHANGE_IN_PROGRESS = True 
      unlockSS ActiveSheet 
      Dim dbHost As Variant 
      Dim hNmRng As Range 
      Set hNmRng = ActiveWorkbook.Names("valid_lookups").RefersToRange 
     dbHost = Application.VLookup(Target.Value, hNmRng, 2, False) 

     Range("C" & Target.row).Value = dbHost 
     lockSS ActiveSheet 
     FLAG_CHANGE_IN_PROGRESS = False 
     End If 
    End If 

    If Not Intersect(ActiveCell, ActiveWorkbook.Names("HostAddRange").RefersToRange) Is Nothing Then 

    End If 
End Sub 

代碼外部模塊：

Sub lockSS(ByVal sheet As Sheet1) 
    sheet.Protect Password:=[NOT SHOWN], UserInterfaceOnly:=True, DrawingObjects:=False 
    Application.EnableEvents = True 
End Sub 

Function getVldtnList(ByVal dbName As String) 
    Dim vrtmatchRow As Variant 
    Dim rng As Range 

    If dbName = "" Then 
     getVldtnList = "" 
     Exit Function 
    End If 

    ' this is a pre-defined range having entries for: 
    ' DB Name - Column 1 
    ' DB CI ID - Column 2 
    ' DB Host - Column 3 

    Set rng = ActiveWorkbook.Names("valid_db_nms").RefersToRange 

    ' find the value of the first row in the range that matches the value 
    ' of the dbName parm. NOTE: the final 0 parm tells the match function 
    ' to find an exact match. 
    vrtmatchRow = Application.Match(dbName, rng, 0) 

    If IsError(vrtmatchRow) Then 
     ' NOTE: we should NEVER get here due to the way cell validation is set up. 
     MsgBox "The value entered was not found in the list of valid database values. See xxx for help", vbRetryCancel, "Invalid Entry" 
    Else 
     Dim row As Long 
     Dim strListVals As String 

     Set rng = ActiveWorkbook.Names("valid_db_info").RefersToRange 
     row = vrtmatchRow 

     Do 
     If Len(strListVals) > 0 Then strListVals = strListVals + "," 
     strListVals = strListVals + rng.Cells(row, 2).Value 
     row = row + 1 
     Loop While (rng.Cells(row, 1).Value = dbName) 
    End If 

    getVldtnList = strListVals 
End Function 

Sub unlockSS(ByVal sheet As Sheet1) 
    sheet.Unprotect Password:=[NOT SHOWN] 
    Application.EnableEvents = False 
End Sub 

Answer 1

清除範圍也將重置「鎖定」複選框，所以您需要重置每次

Range("B" & Target.row).Clear