Excel 5 dakika kullanılmazsa şifre sorsun

[sdegirmenci]

Merhaba;
Excel vba ile yaptığım programım var, İş yerinde başka kullanıcıların girmesini önlemek için ,Program 5 dakika kullanlmazsa şifre sorsun. Bu konuda formda arama yaptım, ancak saat üzerine koda rastlamadım, bu konuda yardımcı olabilirseniz çok sevinirim. Saygılarımla

 

[PLİNT]

Merhaba
Bir module aşağıdaki kodları ekleyip deneyiniz.
Kaydetmeden kapanması gerek ise "False" kullanırsınız

[SIZE="2"] Private x

Sub auto_open()
Call sor
End Sub

Sub sor()
If x = Empty Then GoTo 10
şifre = InputBox("DEVAM ETMEK İÇİN ŞİFRE GİRİNİZ", "PAROLA")
If şifre = "" Or şifre <> "123" Then
Application.Quit:
Application.DisplayAlerts = False
ThisWorkbook.Close SaveChanges:[COLOR="Red"]=True[/COLOR]
Application.DisplayAlerts = True
End If
10:
x = 1
x = Now + TimeSerial(0, 5, 0)
Application.OnTime x, "sor"
End Sub
Sub bekle()
If x <> Empty Then
Application.OnTime x, "sor", , False
x = Empty
End If
End Sub[/SIZE]

İşlem yaptıkça zamanın tekrar başlaması için ("Sayfaların" kod prosedürüne)

[SIZE="2"]Private Sub Worksheet_Change(ByVal Target As Range)
Call bekle
Call sor
End Sub


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Call bekle
Call sor
End Sub [/SIZE]

 

[Ömer]

Merhaba,

Bu tür kodlar arka planda sürekli çalışacağı için tavsiye etmem.

Linki inceleyiniz.

http://www.excel.web.tr/f48/5-dk-arayla-caly-an-makro-t74469.html

Not: Geç kalmışım. Sayın Plint'in cevabını yeni gördüm.

.

 

[sdegirmenci]

Sayın Plint; ve Ömer Hocam;
Öncelikle ilginize teşekkür ederim, Sayın Plint kodları uyguladım boş bir modüle kopyaladım,Auto Open altına kopyaladım. Program da en son işlem yaptıktan sonra 10 dakika bekleyip tekrar işlem yaptım, şifre sormadı. Acaba ben isteğimi eksikmi anlattım. Program açıkken 5 dakika işlem yapılmzasa şifre sorsun demek istedim

 

[PLİNT]

Merhaba
Ek dosyayı deneyiniz
10 sn için ayarlıdır, bekletme kodları "Sayfa1" kod sayfasına eklendi bir hücre seçildikçe veya
veri girildikçe zaman yeniden başlayacaktır.
"Call bekle","call sor" komutunu diğer kodlarınıza ekleyebilirsiniz.
http://s3.dosya.tc/server11/9n46jp/zamanli.zip.html

 

[sdegirmenci]

Sayın Plint;
Dosyayı bu linkten indiremiyorum.

 

[PLİNT]

Sayın Plint;
Dosyayı bu linkten indiremiyorum.

Tekrar denermisiniz?
http://www.dosyaupload.com/24Xw

 

[sdegirmenci]

Şimdi indirdim

 

[sdegirmenci]

Sayın Plint; ilginize çok teşekkür ederim. Kodlarıma uygulayacağım. Süreyi artırmak için x = Now + TimeSerial(0, 0, 10) satırında süreyi arırmak yeterlimi yoksa If x = Empty Then GoTo 10 satırındada yükseltme gerekiyormu.

 

[PLİNT]

Sayın Plint; ilginize çok teşekkür ederim. Kodlarıma uygulayacağım. Süreyi artırmak için x = Now + TimeSerial(0, 0, 10) satırında süreyi arırmak yeterlimi yoksa If x = Empty Then GoTo 10 satırındada yükseltme gerekiyormu.

Merhaba
x = Now + TimeSerial(saat,dakika,saniye)
Aşağıdaki gibi 5 dakika aralık için yeterlidir.
x = Now + TimeSerial(0, 5, 0)

 

[sdegirmenci]

Sayın Plint,
Kodları programıma uyguladım.Üzerinde bazı değişiklikler yaptım.Şifre girişini MsgBox üzerinden yaptım, çünkü proğramda 1 den fazla kullanıcı var, girişlerde şifreye göre güvenlik seviyesi yapmak istiyorum. Ancak Ekteki örnek dosyamdan da anlayacağınız üzere şifre girildiğinde Kaynak sayfasında D6 hücresi ile D11 hücresi arasındaki şifrelerden biri girilirse program devam etsin, Şifreler <> Değil ise kapansın. Bu konu da da yardımcı olabilirseniz çok sevinirim Saygılarımla

 

[sdegirmenci]

Sayın Plint
If WorksheetFunction.CountIf(KY.[DVV], UserForm1.şifre.Text) = 0 Then
İle çözdüm. Tekrar çok teşekkür ederim