Belirtilen Tarihten Sonra Şifre Sorma

[sonkaos]

Merhabalar kıymetli vede değerli hocalarım öncelikle çok araştırdığımı ve bulamadığı söylemek isterim...

Yıllar önceki arşivlerde Ömer hocam exelin açılmaması için birşeyler yazmış sağolsun ama ondada şifre istemiyor.

Bu exel dosyayı 1.02.2023'e kadar çalışsın ama bu tarhiten sonra açılmak istenirse şifre istesin. Eğer mümkünsede her açıldığında bunu countback olarak bize şukadar gününüz kaldı diye yazsın.

Eminim bunu arayan birçok insan olduğu gibi bu güzide platforma bunu sağlayabilecek birden çok kıymetli hocamız var. Şimdiden çok teşekkürler.

 

[dEdE]

Dener misiniz?

Sub Test()
Tarih = CDate("01.02.2023")
If Tarih < Date Then
    Sifre = Application.InputBox("Lütfen Şifrenizi Giriniz.", "DİKKAT !!!")
    If Sifre = "" Or Sifre = False Or Sifre <> "x" Then Exit Sub       'Application.Quit
    'Şifre doğruysa yapılacak işlemler.....
Else
    MsgBox Tarih-Date & " Gün kaldı."
End If
End Sub

 

[sonkaos]

Dener misiniz?

Sub Test()
Tarih = CDate("01.02.2023")
If Tarih < Date Then
    Sifre = Application.InputBox("Lütfen Şifrenizi Giriniz.", "DİKKAT !!!")
    If Sifre = "" Or Sifre = False Or Sifre <> "x" Then Exit Sub       'Application.Quit
    'Şifre doğruysa yapılacak işlemler.....
Else
    MsgBox Tarih-Date & " Gün kaldı."
End If
End Sub

Öncelikle teşekkürler benmi yanlış bişey yaptım bilmiyorum ama dünün tarihini yazıp kapatıp açtığımda benden tarih sormadı.

 

[sonkaos]

Bu Makronun endisinin oto çalışması ve verilen tarihi geçmişse otomatik olarak açılması gerekiyorki o tarihe kadar kişi şifreye ihtiyaç duymamalı.

 

[bmutlu966]

Dosyanızın ThisWorkbook kısmına yapıştırınız.

Private Sub Workbook_Open()
sontarih = DateSerial(2023, 1, 1)
If sontarih < Int(Now) Then
    MsgBox "Son kullanim tarihi gecti."
10
sifre = InputBox("Lütfen sifrenizi giriniz.")
    If sifre <> "1234" Then
        MsgBox "Yanlis sifre"
        say = say + 1
        If say = 3 Then MsgBox "Sifeyi 3 defa yanlis girdiniz. Program Kapatilacak.": ActiveWorkbook.Close
        GoTo 10
    End If
Else
    MsgBox sontarih - Int(Now) & " gün kaldi."
End If
End Sub

 

[sonkaos]

Dosyanızın ThisWorkbook kısmına yapıştırınız.

Private Sub Workbook_Open()
sontarih = DateSerial(2023, 1, 1)
If sontarih < Int(Now) Then
    MsgBox "Son kullanim tarihi gecti."
10
sifre = InputBox("Lütfen sifrenizi giriniz.")
    If sifre <> "1234" Then
        MsgBox "Yanlis sifre"
        say = say + 1
        If say = 3 Then MsgBox "Sifeyi 3 defa yanlis girdiniz. Program Kapatilacak.": ActiveWorkbook.Close
        GoTo 10
    End If
Else
    MsgBox sontarih - Int(Now) & " gün kaldi."
End If
End Sub

Çok teşekkür ederiz muazzam çalışıyor. Emeğinize tecrübenize sağlık.