Boa noite!!

Veja se te ajuda...

Private Sub Workbook_Open()
Dim eCount As Range
Set eCount = Sheets("Plan1").Cells(1, 16384) 'Será contado em A1 da planilha (Plan1)

If eCount.Value < 2 Then
        eCount.Value = eCount.Value + 1
        ThisWorkbook.Save
    Else
        
        MsgBox "O arquivo foi expirado."
        ThisWorkbook.Close savechanges:=False
End If
End Sub

Segue link para baixo do arquivo.
http://www.sendspace.com/file/g8wk8h

Att

alexandrevba... obrigado. Para incluir uma mensagem para informar quantos acessos ainda restam, onde e o que preciso acrescentar ao código?

Boa noite!!

Tente assim...

Private Sub Workbook_Open()
Dim eCount As Range
Set eCount = Sheets("Plan1").Cells(1, 16384) 'Será contado em A1 da planilha (Plan1)

If eCount.Value < 5 Then
        eCount.Value = eCount.Value + 1
        MsgBox "Resta apenas " & Range("XFD1").Value & " Tentativas"""
        ThisWorkbook.Save
    Else
        
        MsgBox "O arquivo foi expirado."
        ThisWorkbook.Close savechanges:=False
End If
End Sub

Não testado
Att

cara... ta no caminho certo, só que ta fazendo invertido, ao invés de contar quantos acessos faltam, ta contando a quantidade de acessos.

Boa noite!!

Opss...

Private Sub Workbook_Open()
Dim eCount As Range
Set eCount = Sheets("Plan1").Cells(1, 16384) 'Será contado em A1 da planilha (Plan1)

If eCount.Value < 5 Then
        eCount.Value = eCount.Value + 1
        MsgBox "Resta apenas " & 5 - Range("XFD1").Value & " Tentativas"""
        ThisWorkbook.Save
    Else
        
        MsgBox "O arquivo foi expirado."
        ThisWorkbook.Close savechanges:=False
End If
End Sub

pronto... tópico encerrado. Qundo puder dê uma olhada neste outro: viewtopic.php?f=16&t=5712