1

我试图确保输入到 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
4

1 回答 1

4

清除范围也会重置“锁定”复选框，因此您每次都需要重置它

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

于 2012-07-27T16:26:27.413 回答