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