Hücrenin aktifliğine göre koşullu biçimlendirme

[xternet]

Merhaba Arkadaşlar.

Yapmak istediğim şu:
Bir hücreye koşullu biçimlendirme yapmak istiyorum. Koşul; bazı hücrelerin seçili durumda olması.

Örneğin a1 hücresine "=(a4:a8) seçili iken" (buradaki ifadenin karşılığını soruyorum da diyebiliriz) kodunu yazıcam ve ben a4,a5,a6,a7,a8 hücrelerinden herhangi birine geldiğimde a1 deki biçimlendirme çalışıcak.

İlgilenecek arkadaşlara şimdiden teşekkür ederim.

 

[xternet]

Arkadaşlar eğer koşullu biçimlendirmeden çözümü yoksa makro ile oluşturulabilecek çözümler de olabilir tabi.

 

[karamurselli]

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, [A4:A8]) Is Nothing Then Exit Sub
Range("A1").Interior.ColorIndex = 7
End Sub

 

[karamurselli]

Ancak makro bilgisi olan arkadaşlar yardım ederse;
işlemi geri nasıl alacağımı bulamadım.
Yani A4:A8 aralığındaki işiniz bitip de başka bir hücreyi seçtiğiniz zaman makroyu geri alma işlemini yapamadım.

 

[xternet]

Teşekkür ederim sayın karamurselli. Ancak belirttiğin gibi tam sonuç alınamıyor.

 

[Levent Menteşoğlu]

Yukarıda verilen kodu aşağıdaki gibi deneyin.

[vb:1:badc4b9435]Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Range("A1").Interior.ColorIndex = 7
If Intersect(Target, [A4:A8]) Is Nothing Then Range("A1").Interior.ColorIndex = xlNone
End Sub
[/vb:1:badc4b9435]

 

[xternet]

Başlangıçta Koşullu biçimlendirme ile bu işi çözebileceğimi düşündüğümden örnek dosya eklememiştim. alacağım bilgiyi çalışmama uyarlarım diye düşünmüştüm. Ama işin içine makro girince istediğim çalışmaya uyarlamam zorlaştı. Onun için sayın leventm; sizin kodunuz istediğimi yerine getirmiş olsada benim çalışmama uyarlayamadım. Örnek dosyayı ekliyorum. İncelerseniz memnun olurum.

 

[kombo]

Dosyanız ekte

Kodlar sn.ripek'e aittir.

Edit..Dosyayı yeniledim.

 

[xternet]

Sayın kombo, katkınız için teşekkür ederim ancak benim düşündüğün tam bu şekilde değil. Öncelikle açılıştaki gösteri kısmı benim için fazla. Yani ona gerek yok.
Birde istediğim olayın sadece isimler ve notlarla sınırlı alanda gerçekleşmesini istiyorum. Tüm satır ve sayfada değil. Ayrıca sayfanın şu anki mevcut renklerini değiştirmesek daha güzel olur. Sanırım çok şey istiyorum.

Herkese kolay gelsin.

 

[Levent Menteşoğlu]

Ekteki dosyayı inceleyin.

 

[xternet]

Sn leventm, herzamanki gibi çözümünüz mükemmel ve tam isabet.
Yalnız belki böyle olsada sorun değil ama bu işlemin sadece F9:AA21 aralığında gerçekleşmesi mümkün mü? Eğer karmaşık bir makro kodu oluşacak ise böyle kalsın (Benim başka çalışmalara uyarlamam açısından).
Ama ufak bir operasyın yeterliyse ve mümkünse o şekli daha güzel olacak.

 

[Levent Menteşoğlu]

Kodu aşağıdaki ile değiştirirseniz istediğiniz aralıkta çalışacaktır.

[vb:1:b734e7001d]Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
On Error Resume Next
Cells.FormatConditions.Delete
If Intersect(ActiveCell, [F9:AA21]) Is Nothing Then Exit Sub
Range("f" & ActiveCell.Row & ":g" & ActiveCell.Row).FormatConditions.Add Type:=xlExpression, Formula1:=1
Range("f" & ActiveCell.Row & ":g" & ActiveCell.Row).FormatConditions(1).Interior.ColorIndex = 36
ActiveCell.FormatConditions.Add Type:=xlExpression, Formula1:=1
ActiveCell.FormatConditions(1).Interior.ColorIndex = 15
End Sub
[/vb:1:b734e7001d]

 

[xternet]

Zihninize sağlık Sn. leventm. Teşekkürler.

 

[xternet]

Sn. leventm tam bitti derken sayfaya koruma koyunca kod çalışmadı.
Bu sorunu aşmamız mümkün mü?

 

[Levent Menteşoğlu]

Bu sorunu aşmamız mümkün mü?

Mümkün. Kod içindeki "şifreniz" yazan yere şifrenizi yazın.

[vb:1:585568dca9]Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
On Error Resume Next
activesheet.unprotect "şifreniz"
Cells.FormatConditions.Delete
If Intersect(ActiveCell, [F9:AA21]) Is Nothing Then Exit Sub
Range("f" & ActiveCell.Row & ":g" & ActiveCell.Row).FormatConditions.Add Type:=xlExpression, Formula1:=1
Range("f" & ActiveCell.Row & ":g" & ActiveCell.Row).FormatConditions(1).Interior.ColorIndex = 36
ActiveCell.FormatConditions.Add Type:=xlExpression, Formula1:=1
ActiveCell.FormatConditions(1).Interior.ColorIndex = 15
activesheet.protect "şifreniz"
End Sub
[/vb:1:585568dca9]

 

[xternet]

Yalnız bu durumda sayfa şifreli olsada yazdığımız kod tüm sayfanın şifresini çözüyor. Yani sayfanın şifreli olmasının bir anlamı kalmıyor.

 

[xternet]

Sevgili arkadaşlar bu sorunumun bir çözümü varmı acaba?

 

[Levent Menteşoğlu]

Aşağıdaki kodu sayfanın kod sayfasına kopyalayaran deneyin.

[vb:1:7209826afb]Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error Resume Next
ActiveSheet.Unprotect "şifreniz"
Cells.FormatConditions.Delete
If Intersect(ActiveCell, [F9:AA21]) Is Nothing Then GoTo 10
Range("f" & ActiveCell.Row & ":g" & ActiveCell.Row).FormatConditions.Add Type:=xlExpression, Formula1:=1
Range("f" & ActiveCell.Row & ":g" & ActiveCell.Row).FormatConditions(1).Interior.ColorIndex = 36
ActiveCell.FormatConditions.Add Type:=xlExpression, Formula1:=1
ActiveCell.FormatConditions(1).Interior.ColorIndex = 15
10 ActiveSheet.Protect "şifreniz"
End Sub
[/vb:1:7209826afb]

 

[xternet]

Malesef sayfa şifreliyken de, şifresizken de kod çalışmadı.
Bu arada kodu "thisWorkbook" sayfasına yapıştırdığımı ve şifreleme komutu içinde

Sub sifrele()
For a = 1 To Sheets.Count
Sheets(a).Protect "123" = True
Next
End Sub

Sub sifreac()
For a = 1 To Sheets.Count
Sheets(a).Unprotect "123" = True
Next
End Sub


makrosunu kullandığımı belirteyim.

 

[Levent Menteşoğlu]

Kodu thisworkbook sayfasına değil çalışmasını istediğiniz sayfanın kod sayfasına kopyalayacaksınız.