VBA Critério Data

Question

Alguém pode me ajudar!

A macro abaixo funciona direitinho, mas acontece que se alguém alterar a data do windows ela apaga a célula. Porque a macro base-se na data hoje do windows.

Como faço para resolver este problema?

Sub Apagar_Data_Hoje()
Dim LinhaAtual As Long
LinhaAtual = ActiveCell.Row
If Range("A" & LinhaAtual).Value = Date Then 'se a data na coluna "A" for igual a hoje então apaga uma celula da mesma linha.
ActiveCell.ClearContents
End If
End Sub

Aguardo qualquer resposta dos amigos do fórum!

Answer 1

A função do link abaixo retorna uma data buscada da Internet. Obviamente, se você estiver sem conexão, a rotina não funcionará:

http://stackoverflow.com/questions/16190812/pickup-time-from-internet-servers-vba-excel

---

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

Answer 2

Obrigado Felipe, o procedimento sugerido é muito complexo.

Estou com outra ideia talvez possa funcionar, só depois que encontrar a macro que faz esta comparação saberei se vai dar certo.

Private Sub Workbook_Open() 'Esta Pasta de Trabalho
'Se Data HOJE for MENOR do que célula Plan1 Range ("A1") não faça nada.
'Se Data HOJE for IGUAL ou MAIOR do que a data da Célula ("A1") INSERI data HOJE na celula ("A1")
End Sub
Sub Apagar_Data_Hoje() 'Módulo
'Dim LinhaAtual As Long
LinhaAtual = ActiveCell.Row
If Range("A" & LinhaAtual).Value = Range("A1") Then
ActiveCell.ClearContents
End If
End Sub

Obrigado

Answer 3

Obrigado! Resolvi usando este procedimento.

Private Sub Workbook_Open()
If Range("A1") <= Date Then
Range("A1") = Date
End If
End Sub
Sub Apagar_Data_Hoje() 'Módulo
Dim LinhaAtual As Long
LinhaAtual = ActiveCell.Row
If Range("A" & LinhaAtual).Value = Range("A1") Then
ActiveCell.ClearContents
Else
If resposta <> Date Then
MsgBox " Não Foi possível apagar a célula selecionada. ", vbOKOnly + vbCritical, "ATENÇÃO!  VERIFICAR A DATA"
End If
End If
End Sub

Se o usuário alterar a data do PC para menos para apagar datas anteriores ele não vai conseguir.

Mas se ele alterar a data do PC para mais todo o procedimento não vai atender. Resolvendo somente abrindo a célula A1 pelo programador.

Resolvido.