Block cell filled with VBA

Asked

Viewed 2,083 times

6

We are setting up a routine where when filling a cell (C1, for example), automatically is filled date (A1) and time (B1) in the spreadsheet. Only right after the auto-fill I need the 2 cells to be locked. 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

2 answers

2

To block a cell the worksheet must be protected.

Column 3 must 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 to this protection:

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

Unprotected the worksheet before making the changes and Protect at the end of its function.

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

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 stand:

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’ve helped!

  • Your solution was much better than mine. It was to accept as a response. Thank you very much!

  • Arrange! Thanks for the comment. Hug and Success!

1


If anyone need, I solved with the code below (adapted 2 I found on 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

Browser other questions tagged

You are not signed in. Login or sign up in order to post.