Kilitli Olan Hücreler Farklı Görünsün

[teknadir]

Arkadaşlar;
Yaklaşık 35 sayfadan oluşan bir çalışma kitabım var. Bu sayfalarda bazı hücrelerin kilidini açtım ve sayfayı korudum. Şimdi kilitli hücreler ile kilidi açık hücrelerin farklı görünmesini istiyorum. Mesela kilitli hücreler soluk gri, açık hücreler soluk sarı gibi. Acaba bu mümkün mü?

Şunu da söylemeliyim ki burada soru sorup da cevap alamadığım konu olmadı. Herkese teşekkürler.

 

[Korhan Ayhan]

Merhaba,

Ben sadece kilidi açık hücreleri renklendirdim. Aşağıdaki kodu denermisiniz.

Kod içindeki kırmızı bölümleri kendi sayfa koruma şifrenizle değiştirmeyi unutmayın.

Option Explicit
 
Sub KİLİDİ_AÇIK_HÜCRELERİ_RENKLENDİR()
    Dim Sayfa As Worksheet, Hücre As Range
 
    Application.ScreenUpdating = False
 
    For Each Sayfa In ThisWorkbook.Worksheets
        Sayfa.Unprotect "[COLOR=red]12345[/COLOR]"
        For Each Hücre In Sayfa.Range("A1:" & Sayfa.Range("A1").SpecialCells(xlCellTypeLastCell).Address)
            If Hücre.Locked = False Then Hücre.Interior.ColorIndex = 36
        Next
        Sayfa.Protect "[COLOR=red]12345[/COLOR]"
    Next
 
    Application.ScreenUpdating = True
 
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[teknadir]

Peki bu işlemi nasıl geri alabiliriz. Yani kullanıcı açık olan hücreleri gördükten sonra yazıcıdan çıktı almadan renkleri iptal etsin.

 

[Korhan Ayhan]

Merhaba,

Makroda hücrenin fiziksel rengini değiştirdiğimiz için geri alma gibi bir şansımız yok. Fakat renklendirmeyi koşullu bçimlendirme ile yapabiliriz. Böylece olayı geri almak istediğimizde koşullu biçimlendirmeleri kaldırdığımızda istediğiniz sonuca ulaşırsınız. Bu durumda sayfalarınızda sizin kullandığınız koşullu biçimlendirme olmaması gerekiyor. Bu şekilde işinize yararsa kodu yeniden düzenlerim.

 

[teknadir]

Makroları yeni kavramaya başladım.
İki düğme ve iki makro(renklendir ve renk yok) oluşturdum.
Düğmelere makroları atadım oldu.
Yardımın için teşekkürler.

 

[teknadir]

ŞU ŞEKİLDE:
Ancak bu kodlar sayfa koruması varken çalışmıyor. Sizin gönderdiğiniz kodda bu sorun yoktu. Benim gönderdiğim kodu koruma varken de çalışabilmesi için düzenler misiniz?

Sub Makro2()
'
' Makro2 Makro
'
'
Range("B3:C14,E5:F11,I2,H1:I1,G17:I17").Select
Range("G17").Activate
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End Sub
Sub Makro3()
'
' Makro3 Makro
'
'
ActiveSheet.Shapes("Button 8").Select
Range("B3:C14,E5:F11,H1:I1,I2,G17:I17").Select
Range("G17").Activate
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End Sub

 

[Korhan Ayhan]

Merhaba,

Tabiki dediğiniz gibi yapabilirsiniz. Buradaki sıkıntı şu. Eğer kilidi açık hücrelerde daha önce bir renklendirme kullandıysanız bunlar yok olur. Yani tablo düzeniniz bozulabilir. Tabiki bu şekilde işinize yarıyorsa kullanabilirsiniz.

Benim önereceğim kod aşağıdaki gibi olacaktı. Hücrelere koşullu biçimlendirme uyguladığı için eski renkler bozulmuyor.

Option Explicit
 
Sub KİLİDİ_AÇIK_HÜCRELERİ_RENKLENDİR()
    Dim Sayfa As Worksheet, Hücre As Range
 
    Application.ScreenUpdating = False
 
    For Each Sayfa In ThisWorkbook.Worksheets
        Sayfa.Unprotect "12345"
        For Each Hücre In Sayfa.Range("A1:" & Sayfa.Range("A1").SpecialCells(xlCellTypeLastCell).Address)
            If Hücre.Locked = False Then
                With Hücre
                    .FormatConditions.Delete
                    .FormatConditions.Add Type:=xlExpression, Formula1:="1"
                    .FormatConditions(1).Interior.ColorIndex = 36
                End With
            End If
        Next
        Sayfa.Protect "12345"
    Next
 
    Application.ScreenUpdating = True
 
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub
 
Sub KİLİDİ_AÇIK_HÜCRELERDEKİ_RENGİ_KALDIR()
    Dim Sayfa As Worksheet, Hücre As Range
 
    Application.ScreenUpdating = False
 
    For Each Sayfa In ThisWorkbook.Worksheets
        Sayfa.Unprotect "12345"
        For Each Hücre In Sayfa.Range("A1:" & Sayfa.Range("A1").SpecialCells(xlCellTypeLastCell).Address)
            If Hücre.Locked = False Then
                With Hücre
                    .FormatConditions.Delete
                End With
            End If
        Next
        Sayfa.Protect "12345"
    Next
 
    Application.ScreenUpdating = True
 
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[Korhan Ayhan]

Merhaba,

Aşağıdaki linkte koruma ile ilgi örnek verilmiş. İncelermisiniz.

http://www.excel.web.tr/f48/ifre-korumaly-sheetin-ifresini-makro-ile-girmek-t102313.html

 

[teknadir]

Benim yazdığım kodda kilitli kilitsiz hücreler değil de sadece benim seçtiğim hücrelerde renk değişimi oluyor. Ancak dediğim gibi sayfa korumalı olunca çalışmıyor. Bu kodu sayfa koruması varken çalıştırabilir miyiz? Sizin gönderdiğiniz kod epey yavaş çalışıyor.

 

[teknadir]

Problem Çözüldü.