0

Estou tentando melhorar a planilha de controle da empresa que trabalho, mas estou tendo problema.

Temos que registrar a ligação de um cliente, já consegui fazer para a planilha preencher a Data e Hora automaticamente após preencher o campo Nome. O que quero agora é proteger os campos Data e Hora nesse momento, para que não possa ser alterado. O que está acontecendo é que em algumas linhas o excel bloqueou a linha inteira. Alguém pode me ajudar?

Esse é o código que fiz até aqui.

Private Sub Worksheet_Change(ByVal Alvo As Range)

     Dim limite_maximo As Integer

  limite_maximo = 4000 ' limite ultima linha

  If Alvo.Cells.Count > 1 Or IsEmpty(Alvo) Then Exit Sub

    ' faz nada se mais de uma célula modificada ou se deu delete

  If Alvo.Column = 5 And Alvo.Row >= 4 And Alvo.Row <= limite_maximo Then

    ' o if acima seta onde vai iniciar e o range e = 5 (coluna), row (linha = 4)

    ' desliga captura do evento change

  Application.EnableEvents = False

    ' muda a célula E da linha correspondente

  ' Desprotege

  ActiveSheet.Unprotect

  Alvo.Offset(0, -1).Value = Time() ' Registra a hora (A = 0, D = 3)
  Alvo.Offset(0, -2).Value = Date   ' Registra a data (A = 0, E = 4)
  
  Linha = Alvo.Row
  
  Range("C" & Linha).Locked = True
  Range("e" & Linha).Locked = True

  ' Protege
  ActiveSheet.Protect

  ' religa a captura de eventos
  Application.EnableEvents = True
  End If
End Sub

Essa é a planilha

inserir a descrição da imagem aqui

1 Resposta 1

0

Primeiro você deve inserir Locked = False em todas as células da planilha somente uma vez, com o seguinte código:

Sub Destravar_Tudo()
    ActiveSheet.Unprotect
    ActiveSheet.Cells.Locked = False
End Sub

Pois por padrão em .Protect, todas as células estão com .locked = True

Depois, ao travar cada célula, a planilha é protegida com ActiveSheet.Protect Contents:=True, DrawingObjects:=False, como pode ser visto no código abaixo:

Private Sub Worksheet_Change(ByVal Alvo As Range)
    Dim limite_maximo As Long, linha As Long
    'Tratar Erros
    On Error GoTo sair

    limite_maximo = 4000                         ' limite ultima linha

    If Alvo.Cells.Count > 1 Or IsEmpty(Alvo) Then Exit Sub

    ' faz nada se mais de uma célula modificada ou se deu delete
    If Alvo.Column = 5 And Alvo.Row >= 4 And Alvo.Row <= limite_maximo Then
        ' o if acima seta onde vai iniciar e o range e = 5 (coluna), row (linha = 4)
        ' desliga captura do evento change
        Application.EnableEvents = False

        ' muda a célula E da linha correspondente
        ' Desprotege

        ActiveSheet.Unprotect

        Alvo.Offset(0, -1).Value = Time()        ' Registra a hora (A = 0, D = 3)
        Alvo.Offset(0, -2).Value = Date          ' Registra a data (A = 0, E = 4)

        linha = Alvo.Row

        Range("C" & linha & ":E" & linha).Cells.Locked = True

        ' Protege
        ActiveSheet.Protect Contents:=True, DrawingObjects:=False
    End If
sair:
    ' religa a captura de eventos
    Application.EnableEvents = True
End Sub

Ou para travar manualmente cada linha:

Sub manual_linha()
    Dim linha As Long
    linha = 4
    ActiveSheet.Unprotect
    Range("C" & linha & ":E" & linha).Cells.Locked = True
    ActiveSheet.Protect Contents:=True, DrawingObjects:=False
End Sub

No exemplo, a linha 4 está sendo utilizada, portanto, o intervalo de C4:E4

3
  • Daniel, obrigado pela ajuda. Fiz como disse, mas houve um problema. Ele acabou travando também outras linhas, como na imagem ele travou da E7 até a H7... não entendo porque ele trava outras células que eu não indiquei. indiquei apenas dessas colunas Range("C" & linha & ":E" & linha).Cells.Locked = True Sabe porque isso ocorre?
    – Rivolier
    14/05/2019 às 16:49
  • Estranho. Num teste que fiz não trava as outras 15/05/2019 às 0:59
  • Ele não travou todas, só travou algumas que não estavam na seleção do vba. Pode me mandar o arquivo que você fez para eu ver se tem algum erro no meu?
    – Rivolier
    16/05/2019 às 13:19

Você deve fazer log-in para responder a esta pergunta.

Esta não é a resposta que você está procurando? Pesquise outras perguntas com a tag .