• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

dosya açılışına sınırlama

A

aydogankemal

Katılım
7 Aralık 2006
Mesajlar
160
Excel Vers. ve Dili
Office 365
demo bir dosya yapıyorum,
örneğin dosya benim belirlediğim bir sayıda açılsın son açılışta sayfadaki bütün bilgileri silsin ve kaydet yapsın istiyorum, yardım edebilir misiniz
 
Merhaba,
Aşağıdaki kodu deneyiniz.
Kolay gelsin.

Kod: 
Sub Demo()
'Deneme süresi verme 
Worksheets("Sayfa1").Range("A1") = Worksheets("Sayfa1").Range("A1") + 1
If Worksheets("Sayfa1").Range("A1").Value > 20 Then
MsgBox "Deneme Süreniz Doldu... ", vbCritical, "ÜZGÜNÜM"
End If
    Cells.Select
    Selection.ClearContents
ActiveWorkbook.Save
Application.Quit

End Sub
 
Merhaba,

Basit ve anlaşılır olması itibariyle aşağıdaki kodu inceleyin ve kendinize uyarlayın..

Kodda açılış sayısı "x" ile tanımlıdır.
Kod: 
Private Sub Workbook_Open()
x = 5
[a65536].Value = [a65536].Value + 1
ActiveWorkbook.Save
If x > [a65536].Value Then
MsgBox x - [a65536].Value & " kadar açma hakkınız vardır", vbCritical
ElseIf x = [a65536].Value Then
MsgBox "Son hakkınız ile dosyayı açtınız", vbCritical
ElseIf x < [a65536].Value Then
MsgBox "Hakkınız sona ermiştir..", vbCritical
Cells.ClearContents
[a65536].Value = x + 1
ActiveWorkbook.Save
Application.Quit
End If
End Sub
 
Sayın dEdE önce davranmış.. Benimkide alternatif olsun.. ;-)
 
BİRDE BUNU DENE


Dim sınırlama
Sub DEMO()
sınırlama = GetSetting("sınır", "sınırla", "sınırlama", 0)
MsgBox "DİKKAT!" & Chr(10) & Chr(10) & "Bu proğram " & sınırlama & " kere açılmış.", vbOKOnly, "UYARI"
On Error Resume Next
sınırlama = sınırlama + 1
SaveSetting "sınır", "sınırla", "sınırlama", sınırlama
If sınırlama > 3 Then
MsgBox "Kullanım süreniz doldu..?"
Cells.Select
Selection.ClearContents
ActiveWorkbook.Save
Application.Quit
End If
End Sub
 
halit3' Alıntı:
sınırlama = GetSetting("sınır", "sınırla", "sınırlama", 0)
SaveSetting "sınır", "sınırla", "sınırlama", sınırlama
Genişletmek için tıkla ...

Satın halit3,

Yukarıdaki satırlar için sizden açıklama rica ediyorum.
1- sınırlama değişkeni SaveSetting ile nereye kaydediliyor?
2- Koyu olarak belirttiğim sınır ve sınırla değişkeni kod içinde başka yerde kullanılmamış, gereksiz gibi duruyor(Bu konuda hiç bilgim yok). Bunlar GetSetting komutunun zorunlu bir parametresi midir?
3- GetSetting ve SaveSetting komutları hakkında daha fazla bilgi verebilir misiniz?

Saygılar.
 
Sayın dede kodunuzu kullandım, vba da yürütünce çalışıyor ama dosyada çalışmıyor,
dosya içerisine ekleyerek gönderebilir misiniz
 
Sayın Ayhan Ercan sizinde kodunuzu kullandım, ama o da çalışmıyor, excel ayarlarında hata mı var diye başka kod olan dosyalarımı çalıştırdım onlarda problem yok
dosya içerisine ekleyerek gönderebilir misiniz
 
dEdE' Alıntı:
Satın halit3,

Yukarıdaki satırlar için sizden açıklama rica ediyorum.
1- sınırlama değişkeni SaveSetting ile nereye kaydediliyor?
2- Koyu olarak belirttiğim sınır ve sınırla değişkeni kod içinde başka yerde kullanılmamış, gereksiz gibi duruyor(Bu konuda hiç bilgim yok). Bunlar GetSetting komutunun zorunlu bir parametresi midir?
3- GetSetting ve SaveSetting komutları hakkında daha fazla bilgi verebilir misiniz?

Saygılar.
Genişletmek için tıkla ...

Merhaba sayın dEdE
Bildiğim kadarıyla,
SaveSetting-GetSetting-DeleteSetting

Komutları ile Registerde kayıt tututlup, bir değeri o kayıtta değiştirmek/silmek/okumak için kullanılır.

SaveSetting komutu registerin
HKEY_CURRENT_USER\Software\VB and VBA Program Settings\
altında tutulur.

SaveSetting "sınır", "sınırla", "sınırlama", sınırlama
ile yukarda söz edilen klasörün altına "sınır", onun altına da "sınırla" adındaki klasörün içine "sınarlama" adında bir değer atanır.

sayın halit3 ün kodundan bahsedersek. Kod satırı oraya her geldiğinde bahsi geçen yerde(register) bir değer yükseltilir (sınırlama=sınırlama + 1)

GetSetting komutu ile de o dosyadaki değer döndürülür.

Birde o kodda kullanılmamış olan "DeleteSetting" komutu vardır ki bu komut ile de ismindende anlaşılacağı üzere o değeri silmektir.
Örnek:
DeleteSetting "sınır","sınırla"

Sayın halit3 ün vermiş olduğu kodda bu komut kullanılmamış dolayısıyla dönen değer her defasında 1 artacağından dosya 3 kereden sonra birdaha hiç açılmayacaktır.


Umarım doğru ve anlaşılır bir şekilde anlatmışımdır..
 
aydogankemal' Alıntı:
Sayın Ayhan Ercan sizinde kodunuzu kullandım, ama o da çalışmıyor, excel ayarlarında hata mı var diye başka kod olan dosyalarımı çalıştırdım onlarda problem yok
dosya içerisine ekleyerek gönderebilir misiniz
Genişletmek için tıkla ...


Dosyanız ekte..

5 hak tanınmıştır..
 

Ekli dosyalar

Alternatif:
Kod: 
Sub Auto_Open()
[A1] = [A1] + 1
Thisworkbook.Save
If [A1] > 15 Then
Cells.Delete
Application.Quit
MsgBox "Kullanım süreniz dolmuştur."
ThisWorkbook.Close True
End If
End Sub
15 kullanım.
 
Son düzenleme:
teşekkürler syn Ayhan ercan,
peki bunu tarih belirleyerek yapabilir miyiz
 
aydogankemal' Alıntı:
teşekkürler syn Ayhan ercan,
peki bunu tarih belirleyerek yapabilir miyiz
Genişletmek için tıkla ...

Dosyadaki kodu aşağıdaki ile değiştirerek deneyin.

x = Sınır tarih..

Kod: 
Private Sub Workbook_Open()
Dim x As Date
x = "15.01.2009"
If x >= Date Then
MsgBox DateDiff("d", Date, x) & " günlük kullanım hakkınız kaldı.."
ElseIf x < Date Then
MsgBox "Hakkınız sona ermiştir..", vbCritical
Cells.ClearContents
ActiveWorkbook.Save
Application.Quit
End If
End Sub
 
üstadım teşekkür ederim yardımların için
bir sorum daha olsa???
bir de dosya adı değiştirilirse dosyanın içeriğini silmesini ve açılmamasını nasıl sağlarım yardımcı olur musun
 
aydogankemal' Alıntı:
üstadım teşekkür ederim yardımların için
bir sorum daha olsa???
bir de dosya adı değiştirilirse dosyanın içeriğini silmesini ve açılmamasını nasıl sağlarım yardımcı olur musun
Genişletmek için tıkla ...

Dosya adının "Esas_Dosya.xls" olduğu varsayılsın.

x= Dosya adı (Esas_Dosya)

Kod: 
Private Sub Workbook_Open()
Dim x As String
x = "Esas_Dosya"
If x & ".xls" = ActiveWorkbook.Name Then
MsgBox "Hoşgeldiniz"
Else
MsgBox "Güle Güle", vbCritical
Cells.ClearContents
ActiveWorkbook.Save
Application.Quit
End If
End Sub
 
Sayın aydogankemal,

Benim gönderdiğim kodun ilk satırını aşağıdaki şekilde değiştirip, kodu modüle değil sayfanın koduna yazarsanız çalışacaktır.
Kod: 
Private Sub Workbook_Open()

Sayın Ayhan Ercan,
Konuyu gayet güzel anlatmışsınız. Çok iyi anladım. Teşekkürler.
 
dosyanın yeniden açılması için inbox yordomı koydum

Dim sınırlama
Sub DEMO()
sınırlama = GetSetting("sınır", "sınırla", "sınırlama", 0)
MsgBox "DİKKAT!" & Chr(10) & Chr(10) & "Bu proğram " & sınırlama & " kere açılmış.", vbOKOnly, "UYARI"
On Error Resume Next
sınırlama = sınırlama + 1
SaveSetting "sınır", "sınırla", "sınırlama", sınırlama
If sınırlama > 3 Then
MsgBox "Kullanım süreniz doldu..?"
sifre = InputBox("Giriş için Şifre Girmelisiniz.", _
"Yetkili Kişi", "Proğrama girmek İçin Şifre giriniz.")
If sifre = "excell" Then
MsgBox "Şifre doğru"
DeleteSetting "sınır", "sınırla"
Else
Cells.ClearContents
ActiveWorkbook.Save
Application.Quit
End If
End If
End Sub
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst