• DİKKAT

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

excel sayfasını data girildikten sonra VBA kullanarak otomatik sifreyle kilitleme

Katılım
8 Ocak 2014
Mesajlar
1
Excel Vers. ve Dili
excel 2003, 2010
Merhabalar,

Benim bir sorunum var. Benim bir excel sayfam var içerisinde A dan X kolonuna kadar uzanan bir tablo oluşturdum. Bu tablonun bazı yerleri formul içeriyor. Ben istiyorumki bu tabloda her satırdaki sonuçlar kontrol edildiginde D kolonuna kontrol eden adını girsin. Adı girildigi zaman otomatik olarak aynı satırda yer alan tüm datalar otomatik olarak kilitlensin. Değiştirilmesi otomatik olarak engellensin.
konuyla alakalı youtube da bir makro buldum ama kendi excelime modifiye edemiyorum. Belki birisi yardımcı olabilir. Buldugum yerin linki;
http://www.exceltrainingvideos.com/...et-and-lock-cells-after-data-entry-using-vba/

Makro kodu aşagıda yer alıyor. Yardımcı olabilirseniz çok sevinirim. Teşekkürler.

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Target.Column = 2 Then
confirm = MsgBox(“Do you wish to confirm entry of this data?” _
& vbCrLf & “You will not be allowed to change it!”, vbYesNo, “confirm Entry”)
Select Case confirm
Case Is = vbYes
Dim Cell As Range
With ActiveSheet
.Unprotect Password:=”asdf,1234″
.Cells.Locked = False
For Each Cell In ActiveSheet.UsedRange
If Cell.Value = “” Then
Cell.Locked = False
Else
Cell.Locked = True
End If
Next Cell
.Protect Password:=”asdf,1234″
End With
Case Is = vbNo
Application.Undo
End Select
End If
Application.EnableEvents = True
End Sub
 
Merhaba, kodunuzu birazcık uyarladım, deneyiniz.
Önce sayfadaki tüm hücrelerin kilidini kaldırın daha sonra da kodu sayfanın kod bölümüne yapıştırınız.
Şifreyi kendinize göre değiştiriniz.
İyi çalışmalar...
Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Target.Column = 4 Then
    confirm = MsgBox("Bu girişi onaylıyor musunuz?" _
                    & vbCrLf & "Tüm satır kilitlenecek!", vbYesNo, "Onay")
    Select Case confirm
        Case Is = vbYes
            With ActiveSheet
                .Unprotect Password:="[COLOR="Red"]1234[/COLOR]"
                If Target.Value <> "" Then
                    Target.EntireRow.Locked = True
                End If
                .Protect Password:="[COLOR="red"]1234[/COLOR]"
            End With
        Case Is = vbNo
            Application.Undo
    End Select
End If
Application.EnableEvents = True
End Sub
 
Geri
Üst