Block cell filled with VBA

5

We are setting up a routine where when filling a cell (C1, for example), the date (A1) and time (B1) in the worksheet are automatically filled in. But soon after the autocompletion is done I need the 2 cells to be blocked. I tested the code below, but it did not block. Any suggestions?

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
    
asked by anonymous 01.06.2017 / 15:55

3 answers

1

If someone needs it, I have decided with the code below (I adapted 2 that I found in forums 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
    
01.06.2017 / 18:46
2

I'd like to comment, but I do not have enough points. I tested your code and your code worked perfectly.

    
01.06.2017 / 18:35
2

To lock a cell, the worksheet must be protected.

Column 3 should have the cells unlocked for editing according to your code and enter the following:

Protect:

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

Unprotect:

ActiveSheet.Unprotect

Of course you can add a password for this protection:

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

Unprotect the worksheet before you make the changes and Protect at the end of your function.

Ideal to create a separate function to Protect and Unprotect, something like this:

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

and

Function desproteger(ByVal senha As String Optional)

   ActiveSheet.Unprotect

End Function

Your code would look like:

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

I hope I have helped!

    
01.06.2017 / 19:03