Vremensko limitiranje korišćenja WorkBook-a

Hteo sam postaviti "vremensku zaštitu" korišćenja Excel fajla Kod-om:

Sub Workbook_Open()
Dim pswrd As String, rok As Date
rok = DateSerial(2016, 3, 16)
pswrd = InputBox("Upišite lozinku")
If pswrd = "12345" Then
If Date > rok Then
MsgBox "ISTEKAO JE DATUM ZA UPOTREBU! kontaktirajte autora"
ActiveWorkbook.Close
End If
Else
ThisWorkbook.Close
End If
End Sub

Ali, imam problem.
Kada se fajl otvara - traži lozinku (to je u redu), ali ako se lozinka ne upiše i izabere se: "Sačuvaj" ili "Nemoj sačuvati" - fajl se zatvara (i to je u redu), ali, ako se izabere "Odustani" - dozvoljem je pristup fajlu.
Ako se lozinka ispravno upiše - dolazi se do poruke: "ISTEKAO JE DATUM ZA UPOTREBU! kontaktirajte autora" (i to je u redu) i opet nudi: "Sačuvaj", "Nemoj sačuvati" i "Odustani". Na prve dve komande - zatvara fajl, a na "Odustani" - opet dozvoljava ulaz u fajl.
Radni listovi su zaštićeni (istom lozinkom) i namerno sam stavio datum koji je istekao, radi probe. U jednom momentu mi je Excel čak i prijavio (famoznu) grešku 1004.

Pokušao sam još neke kombinacije, ali mi uvek na dugme "Odustani" omogućava ulazak u fajl. Help!

Pozdrav
u prilogu ti je primjer probne verzije,stavljas vremensko ograničenje koliko želiš.

Potpis

Jasmin

Pogledaj VBA kod autora 'cpearson'

Ovo je OK. Ali mi opet, i dalje, na pritisak dugmeta "odustani" (ukoliko stavim datum koji je istekao) fajl može nastaviti sa radom. Traba mu (VBA kodu) dodati naredbu - liniju, koja će zatvarati fajl posle:: "MsgBox ("Probna verzija je istekla,kontktirajte autora")". A mene VBA samo "obavesti": "MsgBox ("Imate jos " & exdate - Date & "za isprobavanje programa")" - ovde kod datuma piše "-5" (broj dana za koliko je prekoračen datum) i sa aplikacijom se može nastaviti sa radom.

@jakojsako i @Ivek33

Sve sam "sredio" kombinujući vaše dve poruke. Hvala mnogo i pozdrav.

Dok nismo zatvorili temu...
Gde bi - u prvom kodu, kod ovog autora, trebalo se postaviti datum?

Pozdrav,kada istekne trial aplikacija se zatvori i ne moze dalje da radi ,
probaj staviti datum manji od trenutnog datuma da provjeris
a mozes kombinovatii sa macrom neke sljedece događaje ,da usmjeri na tvoju web stranicu,izbrise sve radne listove itd


Sto se tice gdje se postavlja datum za određivanje trial verzije
exdate = "03/15/2016" mjesec/dan/godina


Private Sub Workbook_Open()
Dim exdate As Date
exdate = "03/15/2016"
If Date > exdate Then
MsgBox ("Probna verzija je istekla,kontktirajte autora")
ActiveWorkbook.Close
End If
MsgBox ("Imate jos " & exdate - Date & " dana za isprobavanje programa")
End Sub

Potpis

Jasmin

Odlično! a mogao bi postaviti funkcionalan primjer ovdje na forumu da i ostali članovi foruma vide rješenje ako budu imali sličan problem. Zar ne?

Primjer Trial sa redirekcijom na web stranicu autora

Potpis

Jasmin