Planilha com prazo de validade


#1

Tem como colocar um prazo de validade em uma planilha para que quando ela chegue na data especificada ela seja destivada e o usuário não consiga abrí-la de forma alguma???

obrigado!!!


#2
Private Sub Workbook_Open()
Dim dtexp As Date
  
          'Escolha a data que deverá expirar
     dtexp = ("29/04/2011")
  
     If Date >= #1/11/2010# Then
     If Date >= dtexp Then
  
     ThisWorkbook.Saved = True
  
          'personalize a mensagem na linha abaixo
     MsgBox "Planilha vencida!"         
  
     ThisWorkbook.ChangeFileAccess xlReadOnly
  
     
     ThisWorkbook.Close
          
     End If
     End If
  
End Sub

#3

Muito obrigado!!
Queria saber como que faço para que quando faltar 1 dia para se vencer a planilha apareça uma mensagem para o usuário que a planilha irá se vencer no dia seguinte e que ele não poderá mais usá-la.
desde já agradeço, este fórum é grande valia para os amantes do excel.
obrigado!


#4

adicione isso no início do código

If Date = dtexp -1 Then
MsgBox "Planilha vencerá amanha!"
End If


#5

Oi Francysco.
Eu coloco esta macro em “EstaPasta_de_trabalho” o seguinte algorítimo.
Repare que quando abre a planilha direciona para uma aba “TELA PRINCIPAL” e na mensagem mostra mostra os dias que faltam para se auto-excluir.

Sub WORKBOOK_OPEN()

Worksheets(“TELA PRINCIPAL”).Select
Range(“C5”).Select

Dim valido As Date
valido = (“30/11/2017”)

Dias = DateDiff(“d”, Date, valido)

If Dias > 0 And Dias < 7 Then

MsgBox ("Voce poderá usar esta planilha até : " _
& valido & vbNewLine & “Ligue para XX 999999999 ou mande e-mail para FULANO@hotmail.com” _
& vbNewLine & “Valido por mais: " & Dias & " dias”)

Else

If Dias <= 0 Then

    ThisWorkbook.Saved = True
    
    MsgBox "Este programa está expirado, se auto-excluirá!"

    ThisWorkbook.ChangeFileAccess xlReadOnly
    Kill ThisWorkbook.FullName

Else
MsgBox ("BEM VINDO " & vbNewLine & "VÁLIDO ATÉ :  " & valido)
End If

End If

ActiveSheet.Protect (“XXX”)

End Sub

Espero que ajude.