Kilitsiz veya Kilitli Hücrelerin Alanını Görme

[hakki83]

Merhaba değerli hocalarımız

Ekteki dosyada
D3:F6
ve
H5:I9
alanlarının hücresel özellikleri "kilitsizdir".

Kilitsiz veya kilitli olan bu alanların adresini gösteren kodu oluşturabilir miyiz?

Yani (Uydurma yazıyorum)

MsgBox Selection.Locked = False.Adress
ve
MsgBox Selection.Locked = True.Adress
kodlarını.

Levent Hocamızın ve Korhan Hocamızın konuyla benzer çok güzel kodları vardı.

 

[hamitcan]

Bu şekilde dener misiniz ?

Sub Kilitli_Hucre_Adresleri()
    ActiveSheet.UsedRange.Select
    For Each hcr In Selection
        If hcr.Locked Then
        kilitli = kilitli & "," & hcr.Address
        Else
        kilitsiz = kilitsiz & "," & hcr.Address
        End If
    Next
    MsgBox kilitli, , "Kilitli Hücreler"
    MsgBox kilitsiz, , "Kilitsiz Hücreler"
End Sub

 

[hakki83]

Hamitcan hocamız, önce emeğinize bilginize sağlık. Güzel bir kod yazmışsınız.

Kodlar şöyle çalışıyor;

Kilitsiz hücreler sayfanın neresinde bulunuyorlarsa, o alan koca bir dikdörtgen olarak seçiliyor.
Ve hem kilitlilerin hücre adreslerini, hem de kilitsizlerin hücre adreslerini, tek tek yazarak mesaj kutusunda gösteriyor. Gayet güzel.

Bu noktada seçilmiş olan alandaki kilitli olan hücrelerin bilgisine gerek olmadığını fark etmiş oldum.

Fakat şunu yapabilir miyiz? (Yapılamıyorsa da hiç sorun yok, böyle de çok güzel)

Hücreleri tek tek değil de, ikinci eklediğim örnek dosyaya göre
mesela

B2:C4, C5:C8, F3:F7

şeklinde yazmasını sağlayabilir miyiz?

Ya da benzer olarak başka şekilde

B2:B4, C2:C8, F3:F7

şeklinde yazmasını sağlayabilir miyiz?

Yani maksat, daha kısa bilgi verilmiş olsun.

Olmayacak bir şey ise hiç sorun yok, böyle de güzel.

 

[hamitcan]

Böyle dener misiniz ?

Sub Kilitsiz_Hucre_Adresleri()
    ActiveSheet.UsedRange.Select
    x = Selection.Row
    x1 = Selection.Rows.Count + x - 1
    y = Selection.Column
    y1 = Selection.Columns.Count + y - 1
    For j = y To y1
    For i = x To x1
        If Cells(i, j).Locked = False Then
           a = a & ":" & Cells(i, j).Address(False, False)
        End If
    Next
        If a <> "" Then b = b & Chr(10) & Mid(a, 2, 2) & ":" & Right(a, 2): MsgBox b
        a = ""
    Next
End Sub

 

[hakki83]

Değerli hocamız çok çok güzel olmuş. Elinize sağlık.

Sadece (eğer olabiliyorsa) şunu yapabilir miyiz?

Örnek3 dosyasında düğmeye basınca 5 adet mesaj kutusu çıkacak.

Sadece 5'inci mesaj kutusunun çıkmasını sağlayabilir miyiz? (Yani son mesaj kutusunun)

Zira en doğru sonucu veren (örnek3'e göre) son mesaj kutusu olan 5'inci kutu olduğu için.

Bunu da yapabilirsek konu tamamen çözülmüş demektir..

 

[hamitcan]

Msgbox ın yerini değiştirin.

Sub Kilitsiz_Hucre_Adresleri()
    ActiveSheet.UsedRange.Select
    x = Selection.Row
    x1 = Selection.Rows.Count + x - 1
    y = Selection.Column
    y1 = Selection.Columns.Count + y - 1
    For j = y To y1
    For i = x To x1
        If Cells(i, j).Locked = False Then
           a = a & ":" & Cells(i, j).Address(False, False)
        End If
    Next
        If a <> "" Then b = b & Chr(10) & Mid(a, 2, 2) & ":" & Right(a, 2)
        a = ""
    Next
     MsgBox b
End Sub

 

[hakki83]

Bilgisayar başına geçer geçmez hemen deneyeceğim Hamitcan hocamız.

 

[hakki83]

Hocam konuyu çözdünüz, teşekkür ederim, bilginize sağlık.