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 に答える