Planilha com vencimento atualizável


#1

Boa tarde a todos do fórum,

Como é uma planilha do trabalho, não poderei postar ela aqui, mas postarei o código para que vocês possam me auxiliar abaixo.

Private Sub Workbook_Open()
Application.EnableCancelKey = xlDisabled

Dim dt As Date

'Escolha a data em a Pasta de Trabalho deverá expirar (ano, mês, dia)
 dt = DateSerial(2020, 12, 31)
 If Date >= dt Then
 MsgBox "Esta Pasta de Trabalho expirou! Favor contatar o Sr. XXX)"

ThisWorkbook.Close SaveChanges:=False
End If

 ActiveWorkbook.Unprotect "N71FX4JS"
 Sheets("DATAS").Visible = True
 Sheets("Plano - 2ª versão").Visible = True
 Sheets("BASE PLANO").Visible = True
 Sheets("Plan1").Visible = True

End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)

Sheets(“DATAS”).Visible = False
Sheets(“Plano - 2ª versão”).Visible = False
Sheets(“BASE PLANO”).Visible = False
Sheets(“Plan1”).Visible = False
ActiveWorkbook.Protect “N71FX4JS”
ThisWorkbook.Save

End Sub

Com base nesse código que encontrei em minhas buscas na internet, realmente a função de vencimento da planilha atende ao que estava buscando, exceto que no momento que a planilha vence, é impossível adicionar mais prazo nela, até mesmo para mim, que no caso gostaria de ser um tipo de “Administrador” dela.

O processo de adicionar mais prazo de vencimento na planilha é necessário, pois a enviamos a pessoas especificas que podem ter o acesso por determinado período.

Só que essas as pessoas que receberam a planilha vão retornar ela para mim em algum momento. para que eu possa verificar o que eles incluiram na planilha até antes dela vencer, e caso for necessário, eu incluo mais prazo e reenvio pra pessoa ou não.

Espero que tenha conseguido ser claro e espero que os amigos do fórum possam me ajudar.

Obrigado!


#2

Crie uma especie de prmissão para edição do arquivo. Aqui vai um exemplo fazendo uma verificação pelo nome de usuário do windows.

Ex: Meu usuário do Windows é “andre.arruda”. Logo:

Ficaria assim:

   Private Sub Workbook_Open()
   If VBA.Environ("username") <> "andre.arruda"  Then ' mude aqui 
    'Seu código aqui..  
   End if
   End Sub

Dessa forma, esse arquivo só poderá ser editado ou alterado sua validade se ele for aberto na sua máquina.

Abrç!


#3

xlarruda, boa tarde.

Inclui o código conforme você havia informado e está retornando este erro:

image

Tens alguma ideia do que pode ter ocasionado? :confused:


#4

Estranho… qual a versão do seu excel?


#5

xlarruda, colei abaixo a versão do meu Excel.

image


#6

Desculpe cara, não sei dizer exatamente o que é mas a verdade é que o Excel 2016 trouxe um série de incompatibilidades junto com ele.
Se eu achar alguma solução, atualizo minha resposta.


#7

Acabei encontrando outro código na Net que faz a verificação através do Login do Windows e não dá aquele erro citado anteriormente.

Private Sub Workbook_Open()
Application.EnableCancelKey = xlDisabled

Dim dt As Date

Set ObjNetwork = CreateObject(“WScript.Network”)
GetuserN = ObjNetwork.UserName
If “GetUserN” <> “gabriel.becker” Then
'Escolha a data em a Pasta de Trabalho deverá expirar (ano, mês, dia)
dt = DateSerial(2020, 12, 31)
If Date >= dt Then
MsgBox “Esta Pasta de Trabalho expirou! Favor contatar o Sr. XXX”
ThisWorkbook.Close SaveChanges:=False
End If
End If
ActiveWorkbook.Unprotect “N71FX4JS”
Sheets(“DATAS”).Visible = True
Sheets(“Plano - 2ª versão”).Visible = True
Sheets(“BASE PLANO”).Visible = True
Sheets(“Plan1”).Visible = True

End Sub

Quando a planilha vence, mesmo que eu esteja com o login gabriel.becker eu não consigo ter acesso.

Será que está faltando algo no código?


#8

Tem algo errado com a verificação de usuário.
Pode ser na digitação do nome de usúario por exemplo .

Outra coisa, não sei se é possivel ter nomes com letra maiúscula , mas o excel reconhece essa diferença também. Se isso acontecer, ele também vai tratar seu login como diferente.


#9

Na verdade quando eu disse que abria a planilha vencida e nada ocorria, acabei sendo meio vago.
Coloquei 2 prints abaixo dos dois erros que a planilha apresenta, no momento de abrir e no momento de fechar.

Erro ao abrir a planilha:
image

Erro ao fechar a planilha:
image