セルを保護しながらドロップダウンオプションを許可する

Question

もっと良い方法があるかもしれませんが、私にはアイデアがあり、これまでのテストではうまく機能しているようです。

Worksheet_SelectionChangeそこで、ユーザーがリストで何をしているかを監視するために使用します。
セルが選択されるとシートのロックを解除し、他のセルが選択されると再びロックします。
私のリストはN26にあることに注意してください

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("N26")) Is Nothing Then
    ActiveSheet.Unprotect
Else
    ActiveSheet.Protect
End If
End Sub

これの問題は、明らかに、セルを選択して、何でも貼り付けることができるはずだということです。

したがって、ユーザーが何かを貼り付けているかどうかを確認する必要がありますが、ここでいくつか興味深いものを見つけました。https://stackoverflow.com/questions/27818152/excel-vba-how-to-detect-if-something-was-pasted-in-a-worksheet

これにより、何かが貼り付けられたかどうかを確認し、元に戻すことができます。

これらを組み合わせて変更し、ユーザーがロック解除されたセルに貼り付けられるようにしましたが、には貼り付けられませんN26。

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("N26")) Is Nothing Then 'Data validation list adress
    ActiveSheet.Unprotect
Else
    ActiveSheet.Protect
End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("N26")) Is Nothing Then
  Dim UndoList As String
  '~~> Get the undo List to capture the last action performed by user
  UndoList = Application.CommandBars("Standard").Controls("&Undo").List(1)

  '~~> Check if the last action was not a paste nor an autofill
  If Left(UndoList, 5) = "Paste" Then
        With Application
            .EnableEvents = False
            .Undo                  'Undo paste
            .EnableEvents = True
        End With
  End If
End If
End Sub

英語版の Excel を使用していない場合、これらの値の一部が変わる可能性があることに注意してください。自分の言語に"&Undo"合わせて変更する必要がありました。(UndoList, 5) = "Paste"

次の質問にもこれを使用できると思います。再度貼り付けを許可する場合は、貼り付けのすべての変更をチェックし、正しい場合はIsNumeric(Target.value)チェックを実行し、失敗した場合は元に戻します。

Answer 1