6

Estamos montando uma rotina onde ao preencher uma célula (C1, por exemplo), automaticamente é preenchida data (A1) e hora (B1) na planilha. Só que logo após ser feito o preenchimento automático eu preciso que as 2 células sejam bloqueadas. Testei o código abaixo, mas não bloqueou. Alguma sugestão?

Private Sub Worksheet_Change(ByVal Alvo As Range)
     Dim limite_maximo As Integer
  limite_maximo = 1000 ' 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 = 3 And Alvo.Row >= 2 And Alvo.Row <= limite_maximo Then
    ' o if acima seta onde vai iniciar e o range c = 3 (coluna), row (linha = 2)
    ' desliga captura do evento change
  Application.EnableEvents = False
    ' muda a célula C da linha correspondente

  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)

  Alvo.Offset(0, -1).Locked = True ' aqui devia bloquear
  Alvo.Offset(0, -2).Locked = True ' aqui devia bloquear

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

2 Respostas 2

2

Para bloquear uma célula a planilha deve estar protegida.

A coluna 3 deve ter as células desbloqueadas para edição conforme seu código e insira o seguinte:

Proteger:

    ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
        False, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
        AllowFormattingRows:=True, AllowFiltering:=True, 
        AllowUsingPivotTables:= _
        True

Desproteger:

ActiveSheet.Unprotect

Claro que pode adicionar uma senha para essa proteção:

    ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
        False, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
        AllowFormattingRows:=True, AllowFiltering:=True, 
        AllowUsingPivotTables:= _
        True, _ 
        Password:="senha"

Desproteja a planilha antes de fazer as alterações e Proteja no final de sua função.

Ideal criar uma função em separado para Proteger e Desproteger, algo assim:

Function proteger(byVal senha As String Optional)

ActiveSheet.Protect _
    DrawingObjects:=False, _
    Contents:=True, _
    Scenarios:=False, _
    AllowFormattingColumns:=True, _
    AllowFormattingCells:=True, _
    AllowFormattingRows:=True, _
    AllowFiltering:=True, _
    AllowUsingPivotTables:=True, _
    AllowSorting:=False, _
    Password:=senha
    '### Opções de Seleção de Células ###
    'ActiveSheet.EnableSelection = xlUnlockedCells
    'ActiveSheet.EnableSelection = xlNoSelection
    'ActiveSheet.EnableSelection = xlNoRestrictions
End Function

e

Function desproteger(ByVal senha As String Optional)

   ActiveSheet.Unprotect

End Function

Seu código ficaria:

Private Sub Worksheet_Change(ByVal Alvo As Range)
     Dim limite_maximo As Integer
  limite_maximo = 1000 ' 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 = 3 And Alvo.Row >= 2 And Alvo.Row <= limite_maximo Then
    ' o if acima seta onde vai iniciar e o range c = 3 (coluna), row (linha = 2)
    ' desliga captura do evento change
  Application.EnableEvents = False
    ' muda a célula C da linha correspondente

  ' Desprotege 
  desproteger

  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)

  Alvo.Offset(0, -1).Locked = True ' aqui devia bloquear
  Alvo.Offset(0, -2).Locked = True ' aqui devia bloquear

  ' Protege 
  proteger

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

Espero ter ajudado!

2
  • Sua solução ficou muito melhor que a minha. Foi aceitar como resposta. Muito obrigado!
    – Diego
    Commented 1/06/2017 às 18:02
  • Disponha! Obrigado pelo comentário. Abraço e Sucesso!
    – Evert
    Commented 1/06/2017 às 18:03
1

Caso alguém precise, resolvi com o código abaixo (adaptei 2 que achei em fóruns gringos)

Option Explicit

Dim blnUnlockedAllCells As Boolean
Private Sub Worksheet_Change(ByVal Target As Range)

    Const RangeToLock As String = "A:A,B:B" '<<  DEFINE AS COLUNAS

    If Target.Cells.Count > 1 Then Exit Sub

    If Target.Column = 3 And Target.Row >= 2 And Target.Row <= 1000 Then
    ' o if acima garante que a célula modificada c = 3 (coluna), row (linha = 1)

    Target.Offset(0, -1).Value = Time() ' Registra a hora (C = 0, B = -1)
    Target.Offset(0, -2).Value = Date   ' Registra a data (C = 0, A = -2)

    ' INICIA BLOQUEIO DA CELULA UTILIZADA
    If Not blnUnlockedAllCells Then
        Me.Cells.Locked = False
        On Error Resume Next
        Me.Range(CStr(RangeToLock)).SpecialCells(2).Locked = True
        On Error GoTo 0
        blnUnlockedAllCells = True
        Me.Protect Password:="pwd", userinterfaceonly:=True
    End If

    If Not Application.Intersect(Target, Me.Range(CStr(RangeToLock))) Is Nothing Then
        If Len(Target) Then Target.Locked = True
    End If

    End If ' IF COLUNAS
End Sub

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 .