VBA BLOQUEAR CELULAR E LIBERAR CELULAS

Question

Boa Tarde Srs.,

Gostaria de uma ajuda, Tenho 3 colunas A, B , C

Na coluna A tenho datas de 01 de Janeiro a 31 de Dezembro..

Na B tenho status da ordem 1 - Fechado 2 Pendente 3 Aberto

Na C tenho Ok ou Branco

Gostaria que a Macro validasse as datas e liberasse as celulas conforme data atual (TODAY () ou HOJE ()).,

Para eu preencher a coluna B ou C.

Pois tem umas pessoas aqui no trabalho que querem preencher os dados dias depois..

Queria que todos preenchessem só na data atual..

Muito Obrigado.

 

Answer 1

Marco, Boa tarde!

 

Não sei se é exatamente isso que você precisa, mas pelo que eu entendi seria algo mais ou menos assim:

 

Sub DesbloqueiaHoje()
  Dim ContLinhas As Integer 'Contador de Linhas
  
  'Desprotege a planilha
  ActiveSheet.Unprotect
  
  'Procura todas as células até encontrar uma célula vazia na coluna A
  ContLinhas = 1
  While (Range("A" & CStr(ContLinhas)).Text <> "")
  
    'Desbloqueia quando estiver igual a data atual
    If Range("A" & CStr(ContLinhas)).Value = Date Then
      Range("B" & CStr(ContLinhas)).Locked = False
      Range("C" & CStr(ContLinhas)).Locked = False
    Else
      Range("B" & CStr(ContLinhas)).Locked = True
      Range("C" & CStr(ContLinhas)).Locked = True
    End If
    
    'Verifica a próxima linha
    ContLinhas = ContLinhas + 1
  Wend
  
  'Protege a planilha
  ActiveSheet.Protect
End Sub

 

Qualquer detalhe referente ao código posso esclarecer melhor.

 

Atenciosamente,

Bráulio Figueiredo Pinto

Answer 2

Olá,

Você poderia usar também:

Sub LiberaDataAtual()
  Dim ws As Worksheet
  
  Set ws = ActiveSheet
  
  With ws
    .Unprotect
    .Cells.Locked = True
    .Columns("A").Find(CDate(Format(Date, "Short Date"))).Offset(, 1).Resize(, 2).Locked = False
    .Protect
  End With
  
End Sub

Nota: sugiro que insira esse código no seu evento Worksheet_Activate.

---

Felipe Costa Gualberto - http://www.ambienteoffice.com.br

Answer 3

Ola Pessoal,

    Estou precisando de algo parecido, estou aprendendo a montar um cadastro de clientes e amigos, e quando efetuo o calculo dos anos da pessoa eu gostaria de estar bloqueando para evitar que alguem modifique este campo, tentei usar este metodo conforme segue abaixo, so que esta ocorrendo erro, gostaria da ajuda do pessoal do forum, fico grato a todos, obrg

If (ResultadoAno >0) Then
    Cadastro.Range("C12") = ResultadoAno
    Cadastro.Range("C12").Select
     Selection.Locked = True
     Selection.FormulaHidden = False
     Contents:=True, Scenarios:=True
end if

    

Answer 4

Ola Pessoal,  consegui resolver da seguinte maneira, caso alguem esteja passando pela mesma dificuldade

'Desproteger o Formulario
Cadastro.Unprotect Password:=""

If (ResultadoAno >0) Then
    Cadastro.Range("C12") = ResultadoAno
    Cadastro.Range("C12").Select
     Selection.Locked = True
     Selection.FormulaHidden = False
     Contents:=True, Scenarios:=True
end if

'Proteger o Formulario
Cadastro.protect Password:=""

abraço a todos