skaan
Altın Üye
- Katılım
- 11 Mart 2005
- Mesajlar
- 261
- Excel Vers. ve Dili
- Microsoft 365
- Altın Üyelik Bitiş Tarihi
- 12-11-2025
Merhaba;
Sitemizdeki daha önceki yazışmaları örnek alarak kendime aşağıdaki kodları yazdım. Bu kodlarda Belli Hücre Aralığını Şifre İle Koruma süreci çalışıyor. Sorun yaşamıyorum.
Ancak şifre korumalı hücrelerı yada bulundugu satırları silmek istediğimde de herdefasında şifre sorgusu ekrana gelıyor. ben silme işlemi yapıldığında şifre sorulmasını istemıyorum. Sadece düzeltme yapılmak istenır ise şifre sorsun istemekteyim. Kodları buna göre düzenlemekte bana yardımcı olursanız çok sevinirim. yardımcı olmanızı rica ediyorum. Kodların kullanıldığı örnek dosyam ektedir..
Private Sub Worksheet_Change(ByVal Target As Range)
Dim cell As Range
Dim password As String
Dim attempt As Integer
Dim maxAttempts As Integer
Dim userPassword As Variant
password = "adasoy"
maxAttempts = 3
If Application.CutCopyMode = xlCopy Or Application.CutCopyMode = xlCut Then
Exit Sub
End If
For Each cell In Target
If Not Intersect(cell, Me.Range("AB:AE")) Is Nothing Then
For attempt = 1 To maxAttempts
userPassword = InputBox("Lütfen şifreyi girin. " & (maxAttempts - attempt + 1) & " deneme hakkınız kaldı.")
If StrPtr(userPassword) = 0 Then
MsgBox "Şifre ekranından çıkılıyor. İşleme devam edebilirsiniz."
Application.EnableEvents = False
Application.Undo
Application.EnableEvents = True
Exit Sub
ElseIf userPassword = password Then
Exit Sub
Else
If attempt < maxAttempts Then
MsgBox "Yanlış şifre. Lütfen tekrar deneyin."
Else
MsgBox "Maksimum deneme sayısına ulaşıldı. Değişiklikler geri alınıyor."
Application.EnableEvents = False
Application.Undo
Application.EnableEvents = True
Exit Sub
End If
End If
Next attempt
End If
Next cell
End Sub
Sitemizdeki daha önceki yazışmaları örnek alarak kendime aşağıdaki kodları yazdım. Bu kodlarda Belli Hücre Aralığını Şifre İle Koruma süreci çalışıyor. Sorun yaşamıyorum.
Ancak şifre korumalı hücrelerı yada bulundugu satırları silmek istediğimde de herdefasında şifre sorgusu ekrana gelıyor. ben silme işlemi yapıldığında şifre sorulmasını istemıyorum. Sadece düzeltme yapılmak istenır ise şifre sorsun istemekteyim. Kodları buna göre düzenlemekte bana yardımcı olursanız çok sevinirim. yardımcı olmanızı rica ediyorum. Kodların kullanıldığı örnek dosyam ektedir..
Private Sub Worksheet_Change(ByVal Target As Range)
Dim cell As Range
Dim password As String
Dim attempt As Integer
Dim maxAttempts As Integer
Dim userPassword As Variant
password = "adasoy"
maxAttempts = 3
If Application.CutCopyMode = xlCopy Or Application.CutCopyMode = xlCut Then
Exit Sub
End If
For Each cell In Target
If Not Intersect(cell, Me.Range("AB:AE")) Is Nothing Then
For attempt = 1 To maxAttempts
userPassword = InputBox("Lütfen şifreyi girin. " & (maxAttempts - attempt + 1) & " deneme hakkınız kaldı.")
If StrPtr(userPassword) = 0 Then
MsgBox "Şifre ekranından çıkılıyor. İşleme devam edebilirsiniz."
Application.EnableEvents = False
Application.Undo
Application.EnableEvents = True
Exit Sub
ElseIf userPassword = password Then
Exit Sub
Else
If attempt < maxAttempts Then
MsgBox "Yanlış şifre. Lütfen tekrar deneyin."
Else
MsgBox "Maksimum deneme sayısına ulaşıldı. Değişiklikler geri alınıyor."
Application.EnableEvents = False
Application.Undo
Application.EnableEvents = True
Exit Sub
End If
End If
Next attempt
End If
Next cell
End Sub
Ekli dosyalar
-
39 KB Görüntüleme: 0
Son düzenleme: