Este fórum está sendo desativado

[lucianocalculista]

Pessoal, tenho uma planilha com proteção de usuário e senha, além de prazo para utilização. Contudo, o código esta permitindo acesso a planilha, mesmo sem digitar a senha e usuário, uma vez que, clicando em cancelar na caixa inputbox, a planilha abre mesmo sem digitar os dados de usuário e senha.

Segue codigo:

Private Sub Workbook_Open()
Dim dt As Date

'Escolha a data em a Pasta de Trabalho deverá expirar (ano, mês, dia)

dt = DateSerial(2021, 12, 31)

If Date >= dt Then
MsgBox "Esta Pasta de Trabalho expirou! Favor contatar o administrador através do e-mail lucianocalculista@yahoo.com.br ou pelo WhatsApp (31) 99610-8436."

ThisWorkbook.Close SaveChanges:=False

End If

Reiniciar:
Usuario = InputBox("Digite o seu usuário:")
Senha = InputBox("Digite a sua senha:")

On Error Resume Next
ActiveSheet.Unprotect
If Err Then
MsgBox "senha errada"
ThisWorkbook.Close SaveChanges:=False
End If
On Error GoTo 0

senha_certa = Worksheets("Logins").Cells.Find(Usuario).Offset(0, 1)
MsgBox "Esta Pasta de Trabalho esta ativa!"
If Senha & "" <> senha_certa & "" Then

ThisWorkbook.Close SaveChanges:=False


End If



End Sub

[AfonsoMira]

Boas experimente algo deste género:

Código: Selecionar todos

Private Sub Workbook_Open()
Dim dt As Date

'Escolha a data em a Pasta de Trabalho deverá expirar (ano, mês, dia)

dt = DateSerial(2021, 12, 31)

If Date >= dt Then
    MsgBox "Esta Pasta de Trabalho expirou! Favor contatar o administrador através do e-mail lucianocalculista@yahoo.com.br ou pelo WhatsApp (31) 99610-8436."
    
    ThisWorkbook.Close SaveChanges:=False
End If

Reiniciar:
Usuario = InputBox("Digite o seu usuário:")
If Usuario = "" Then GoTo Reiniciar:
inserirSenha:
Senha = InputBox("Digite a sua senha:")
If Senha = "" Then GoTo inserirSenha

On Error Resume Next
ActiveSheet.Unprotect
If Err Then
    MsgBox "senha errada"
    ThisWorkbook.Close SaveChanges:=False
End If
On Error GoTo 0

senha_certa = Worksheets("Logins").Cells.Find(Usuario).Offset(0, 1)
MsgBox "Esta Pasta de Trabalho esta ativa!"
If Senha & "" <> senha_certa & "" Then
    ThisWorkbook.Close SaveChanges:=False
End If

End Sub