☰

Protegendo uma CÉLULA, mas permitindo opções suspensas

tag-icon • tag-icon microsoft-excel worksheet-function vba
Protegendo uma CÉLULA, mas permitindo opções suspensas

Quero proteger uma célula, mas também permitir que um usuário selecione opções na lista suspensa?

Eu li a pergunta abaixo que não fornece uma resposta.

Protegendo uma célula, mas permitindo que a lista suspensa funcione

Desproteger a célula não é o que eu quero fazer, pois um usuário pode simplesmente colar a célula e a validação dos dados desaparece.

Existe uma maneira de ter uma CÉLULA bloqueada e ter a proteção de planilha ativada, mas ainda permitir que as opções da lista de validação de dados sejam selecionadas?

Vou tentar qualquer opção, incluindo VBA.

Responder1

Pode haver uma maneira melhor de fazer isso, mas tive uma ideia e parece funcionar bem com meus testes até agora.

Então eu uso Worksheet_SelectionChangepara monitorar o que o usuário está fazendo com a lista.
Simplesmente desbloqueio a planilha quando a célula é selecionada e a bloqueio novamente quando outra coisa é selecionada:
Observe que minha lista está em 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

O problema com isso é obviamente que você deve ser capaz de selecionar a célula e colar o que quer que seja.

Então precisamos verificar se o usuário está colando alguma coisa, e encontrei algumas coisas interessantes aqui:https://stackoverflow.com/questions/27818152/excel-vba-how-to-detect-if-something-was-pasted-in-a-worksheet

Assim, com isso podemos verificar se algo foi colado e desfazer.

Eu os juntei, modifiquei e assim o usuário pode colar em qualquer célula desbloqueada, mas não em 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

Observe que alguns desses valores podem mudar se você não estiver usando uma versão em inglês do Excel. Eu tive que mudar "&Undo"e (UndoList, 5) = "Paste"para o meu idioma.

Acho que você também pode usar isso para sua próxima pergunta. Se você permitir colar novamente, mas verificar todas as alterações para colar e, se for verdade, execute IsNumeric(Target.value)a verificação e desfaça se falhar.

informação relacionada