-
DİKKAT DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
excel kullanımını sınırlama
- Konbuyu başlatan recep
- Başlangıç tarihi
- Katılım
- 13 Ekim 2004
- Mesajlar
- 16,057
- Excel Vers. ve Dili
-
Excel 2010-32 bit-Türkçe
Excel 365 -32 bit-Türkçe
Aşağıdaki gibi bir kod deneyin. Kod A1 hücresini her seferinde bir arttırır,10 olduğunda ise dosyayı açılmadan tekrar kapatır. Fakat makrolar devre dışı bırakılırsa bu kod hiç bir işe yaramaz.
[vb:1:3a32f73431]
Sub auto_open()
[a1]=[a1]+1
if [a1]=10 then application.quit
end sub[/vb:1:3a32f73431]
[vb:1:3a32f73431]
Sub auto_open()
[a1]=[a1]+1
if [a1]=10 then application.quit
end sub[/vb:1:3a32f73431]
autu_open makrom varbir tane daha ekleyemiyorum
şöyle
Const strTxtFile As String = "C:\koruma.txt"
Const MyCheckVal As Long = 123456
'
Sub Aut
pen()
Sheet ("ANA SAYFA").Selecet
Dim InputData As Variant
Dim FileNum As Long
Dim x As Integer
FileNum = FreeFile
If Dir(strTxtFile) <> Empty Then
Open strTxtFile For Input As FileNum
x = x + 1
Do While Not EOF(FileNum)
Line Input #FileNum, InputData
If Left(InputData, 6) <> MyCheckVal Then GoTo NoGo:
If x = 1 Then Exit Sub
Loop
Close FileNum
ThisWorkbook.IsAddin = False
Else
NoGo:
ThisWorkbook.IsAddin = True
MsgBox "Kayitli kullanici degilsiniz....", vbCritical, "Kullanicinin dikkatine !"
ThisWorkbook.Close SaveChanges:=False
End If
End Sub
'
bun :hey: un içine nasıl yerleştirebilirim
şöyle
Const strTxtFile As String = "C:\koruma.txt"
Const MyCheckVal As Long = 123456
'
Sub Aut
pen() Sheet ("ANA SAYFA").Selecet
Dim InputData As Variant
Dim FileNum As Long
Dim x As Integer
FileNum = FreeFile
If Dir(strTxtFile) <> Empty Then
Open strTxtFile For Input As FileNum
x = x + 1
Do While Not EOF(FileNum)
Line Input #FileNum, InputData
If Left(InputData, 6) <> MyCheckVal Then GoTo NoGo:
If x = 1 Then Exit Sub
Loop
Close FileNum
ThisWorkbook.IsAddin = False
Else
NoGo:
ThisWorkbook.IsAddin = True
MsgBox "Kayitli kullanici degilsiniz....", vbCritical, "Kullanicinin dikkatine !"
ThisWorkbook.Close SaveChanges:=False
End If
End Sub
'
bun :hey: un içine nasıl yerleştirebilirim
- Katılım
- 13 Ekim 2004
- Mesajlar
- 16,057
- Excel Vers. ve Dili
-
Excel 2010-32 bit-Türkçe
Excel 365 -32 bit-Türkçe
Kodlarınızın en üstüne yazabilirsiniz.
- Katılım
- 13 Ekim 2004
- Mesajlar
- 16,057
- Excel Vers. ve Dili
-
Excel 2010-32 bit-Türkçe
Excel 365 -32 bit-Türkçe
Güvenlik seviyesini düşük yaparsanız otomatikman çalışır.
başka bir bigisayara çalışmamızı aktardığımızda kendiliğinden o bilgisayardaki ofis programının excel makro güvenlik seviyesini ortaya çöekmesini istiyorum. amacım çalışmanın güvenliğini arttirmak. istediğim kadar açılıp kapatılsın. 20 gün sonra kendisini silsin ve başka bilgisayara izinsiz kopyalandığımda açılmasın. tek sorunum makroların givenlik seviyesi .en üst ve makro iptal denince hepsi bozuluyor.
bir yolu var ama ben nasıl bilmiyorum bir excel benim güvenlik seviyemi düşüge indirdiler. ve vürüs bulaştırdılar. nasıl oldu anlayamadım.genellikle yüksek deyip o günden sonra kendi bigisayarım da makrolarını incelkeyebildiğim çalışmaları açıyorum. ilk denemeleri her seferinde internet kafede :agla:
- Katılım
- 22 Aralık 2005
- Mesajlar
- 335
- Excel Vers. ve Dili
- Office - 2019 - Türkçe
Bunu deneyin.
Kod:
Sub auto_open()
If [a1] = "" Then [a1] = "1"
If [a1].Value < 10 Then [a1] = [a1] + 1
If [a1].Value = 10 Then
MsgBox "10 defa açıldı"
ActiveWindow.Close True
End If
ActiveWorkbook.Save
End Sub
Kod:
Sub Auto_Close()
ThisWorkbook.Save
End SubAslında makroları etkinleştirmediğimiz zaman dosya pek işe yaramaz da, yine de konuyu öğrenirsek iyi olur. Mesela dosya komple kullanılmaz hale gelse. Yani A1 hücresinin değeri 5 olunca bir makro devreye girse dosyadaki tüm çalışma sayfalarını silse. Bu yapılabilir sanırım. Yardımlarınızı bekliyorum.
Kod:
Sub auto_open()
ActiveSheet.Unprotect ("dosya koruma şifresi")
If [a1] = "" Then [a1] = "1"
If [a1].Value < 5 Then [a1] = [a1] + 1
If [a1].Value = 5 Then
MsgBox "Kullanım Süreniz Doldu"
ActiveWindow.Close True
End If
ActiveSheet.Protect ("dosya koruma şifresi")
End Sub