Süre Sona Erdirme

[tevfikdemir]

Merhaba Arkadaşlar;
Dosyamın belli bir tarih sonunda çalışmasını bitirmek istiyorum.Bunun için aşağıdaki kodlarla bir şeyler yapmaya çalıştım fakat olmuyor.Konuyla ilgili bilgisi olan varmı?
Saygılar
Private Sub Workbook_Activate()
On Error Resume Next
Application.Visible = False

kayıt = "03.06.2006"
kayıt = Format(kayıt, dd.mm.yyyy)
sonkayıt = Date
sonkayıt = Format(sonkayıt, "dd.mm.yyyy")
If sonkayıt > kayıt Then
MsgBox ("Kullanım Hakkınız Bitti")
End
End If
siparisfrm.Show
End Sub

 

[tevfikdemir]

Konuyla ilgili bilgisi olan varmı ?

Saygılar

 

[alpi]

Yazdığınız kodların çalışması lazım ama ben bir şey sormak istiyorum

On Error Resume Next satırı kodlarınızda neden var anlayamadım

 

[tevfikdemir]

Doğru söylüyorsunuz.Hata olduğunda devam etmemesi gerekiyor.

Teşekkürler.

Kolay gelsin

 

[gunaygergin]

sn: tevfikdemir,

probleminizin çözümü bu olabilirmi acaba;

Private Sub Workbook_Activate()
On Error Resume Next
Application.Visible = False

kayıt = "03/06/2006"
kayıt = Format(kayıt, dd.mm.yyyy)
sonkayıt = Datenow
sonkayıt = Format(sonkayıt, "dd.mm.yyyy")
If sonkayıt > kayıt Then
MsgBox ("Kullanım Hakkınız Bitti")
End
End If
siparisfrm.Show
End Sub

 

[gunaygergin]

tevfikdemir,


çalışamaya bakabildiniz mi?

 

[tevfikdemir]

Syn.Günaygergin

aşağıdaki kodlarla problemi çözdüm teşekkürler.

Application.Visible = False
Dim d, x, y
d = GetSetting("DANISMAN", "Ayarlar", "Ilk Giris", "")
If d = "" Then
SaveSetting "DANISMAN", "Ayarlar", "Ilk Giris", Date
Else
If (Date - CDate(d)) > 365 Then
MsgBox ("Programin Demo Süresi dolmustur.")
DoCmd.Close
Application.Quit
Else

x = GetSetting("DANISMAN", "Ayarlar", "Son Çikis Tarihi", "")
If x = "" Then
'End
Else
If CVDate(x) > Date Then
MsgBox ("Programin Deneme Süresi Doldu Lütfen Israr Etmeyin")
DoCmd.Close
Else
y = GetSetting("DANISMAN", "Ayarlar", "Son Çikis Saati", "")
If (CVDate(x) = Date) And (CVDate > Time) Then
MsgBox ("Programin Deneme Süresi Doldu Lütfen Israr Etmeyin")
DoCmd.Close
End If
End If
x = GetSetting("DANISMAN", "Ayarlar", "Sayi", "1")
MsgBox ("Programi" & x & ". defa çalistiriyorsunuz.")
SaveSetting "DANISMAN", "Ayarlar", "Sayi", x + 1
End If
End If
End If
siparisfrm.Show
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)

SaveSetting "DANISMAN", "Ayarlar", "Son Çikis Tarihi", Date
SaveSetting "DANISMAN", "Ayarlar", "Son Çikis Saati", Time

Application.Visible = True
Application.Quit
End Sub

 

[ŞÜKRÜ ALTUNKUYU]

süre sona erdirme

Merhaba Arkadaşlar,
süre sona erdirme ile alakalı yapmış olduğum bir çalışmanın 03/05/2017 tarihinde sona ererek uyarmasını istiyorum. bununla alakalı aşağdaki kodu buldum. ancak uygulamada hata veriyor.
yardımcı olabilir misiniz.


Private Sub Workbook_Activate()
On Error Resume Next
Application.Visible = False
Dim d, x, y
d = GetSetting("DANISMAN", "Ayarlar", "Ilk Giris", "")
If d = "" Then
SaveSetting "DANISMAN", "Ayarlar", "Ilk Giris", Date
Else
If (Date - CDate(d)) > 365 Then
MsgBox ("Programin Demo Süresi dolmustur.")
DoCmd.Close
Application.Quit
Else

x = GetSetting("DANISMAN", "Ayarlar", "Son Çikis Tarihi", "")
If x = "" Then
'End
Else
If CVDate(x) > Date Then
MsgBox ("Programin Deneme Süresi Doldu Lütfen Israr Etmeyin")
DoCmd.Close
Else
y = GetSetting("DANISMAN", "Ayarlar", "Son Çikis Saati", "")
If (CVDate(x) = Date) And (CVDate > Time) Then
MsgBox ("Programin Deneme Süresi Doldu Lütfen Israr Etmeyin")
DoCmd.Close
End If
End If
x = GetSetting("DANISMAN", "Ayarlar", "Sayi", "1")
MsgBox ("Programi" & x & ". defa çalistiriyorsunuz.")
SaveSetting "DANISMAN", "Ayarlar", "Sayi", x + 1
End If
End If
End If
siparisfrm.Show
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)

SaveSetting "DANISMAN", "Ayarlar", "Son Çikis Tarihi", Date
SaveSetting "DANISMAN", "Ayarlar", "Son Çikis Saati", Time

Application.Visible = True
Application.Quit
End Sub

 

[Mahmut Bayram]

Private Sub Workbook_Activate()
    Dim trh As Date
    trh = "03.05.2017"
    If Date = trh Then
        MsgBox ("Kullanım Süresi Dolmuştur")
        ActiveWorkbook.Close
    End If
    MsgBox ("Kalan Gün : " & trh - Date)
End Sub

 

[askm]

d = GetSetting("DANISMAN", "Ayarlar", "Ilk Giris", "") bu kodda GetSetting ne işe yarıyor.

Bu arada yukarıdaki kodda If Date >= trh Then yapmassak bir gün sonrasında açar. Yani 04.05.2017 de açmaya devam eder.

 

[ŞÜKRÜ ALTUNKUYU]

Private Sub Workbook_Activate()
    Dim trh As Date
    trh = "03.05.2017"
    If Date = trh Then
        MsgBox ("Kullanım Süresi Dolmuştur")
        ActiveWorkbook.Close
    End If
    MsgBox ("Kalan Gün : " & trh - Date)
End Sub

Teşekkürler mahmut bayram bey, verdiğiniz kodlar yeterli oldu.