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

xternet

Altın Üye
Katılım
12 Kasım 2004
Mesajlar
455
Excel Vers. ve Dili
2010 Tr
Altın Üyelik Bitiş Tarihi
12-10-2028
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

Altın Üye
Katılım
12 Kasım 2004
Mesajlar
455
Excel Vers. ve Dili
2010 Tr
Altın Üyelik Bitiş Tarihi
12-10-2028
Arkadaşlar eğer koşullu biçimlendirmeden çözümü yoksa makro ile oluşturulabilecek çözümler de olabilir tabi.
 
Katılım
1 Şubat 2006
Mesajlar
149
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
 
Katılım
1 Şubat 2006
Mesajlar
149
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

Altın Üye
Katılım
12 Kasım 2004
Mesajlar
455
Excel Vers. ve Dili
2010 Tr
Altın Üyelik Bitiş Tarihi
12-10-2028
Teşekkür ederim sayın karamurselli. Ancak belirttiğin gibi tam sonuç alınamıyor.
 

Levent Menteşoğlu

Administrator
Yönetici
Admin
Katılım
13 Ekim 2004
Mesajlar
16,057
Excel Vers. ve Dili
Excel 2010-32 bit-Türkçe
Excel 365 -32 bit-Türkçe
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

Altın Üye
Katılım
12 Kasım 2004
Mesajlar
455
Excel Vers. ve Dili
2010 Tr
Altın Üyelik Bitiş Tarihi
12-10-2028
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.
 
Katılım
17 Şubat 2006
Mesajlar
981
Excel Vers. ve Dili
M.Office Excel 2003 Tr.
Dosyanız ekte

Kodlar sn.ripek'e aittir.

Edit..Dosyayı yeniledim.
 

xternet

Altın Üye
Katılım
12 Kasım 2004
Mesajlar
455
Excel Vers. ve Dili
2010 Tr
Altın Üyelik Bitiş Tarihi
12-10-2028
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. :cry:

Herkese kolay gelsin.
 

xternet

Altın Üye
Katılım
12 Kasım 2004
Mesajlar
455
Excel Vers. ve Dili
2010 Tr
Altın Üyelik Bitiş Tarihi
12-10-2028
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

Administrator
Yönetici
Admin
Katılım
13 Ekim 2004
Mesajlar
16,057
Excel Vers. ve Dili
Excel 2010-32 bit-Türkçe
Excel 365 -32 bit-Türkçe
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

Altın Üye
Katılım
12 Kasım 2004
Mesajlar
455
Excel Vers. ve Dili
2010 Tr
Altın Üyelik Bitiş Tarihi
12-10-2028
Zihninize sağlık Sn. leventm. Teşekkürler.
 

xternet

Altın Üye
Katılım
12 Kasım 2004
Mesajlar
455
Excel Vers. ve Dili
2010 Tr
Altın Üyelik Bitiş Tarihi
12-10-2028
Sn. leventm tam bitti derken sayfaya koruma koyunca kod çalışmadı.
Bu sorunu aşmamız mümkün mü?
 

Levent Menteşoğlu

Administrator
Yönetici
Admin
Katılım
13 Ekim 2004
Mesajlar
16,057
Excel Vers. ve Dili
Excel 2010-32 bit-Türkçe
Excel 365 -32 bit-Türkçe
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

Altın Üye
Katılım
12 Kasım 2004
Mesajlar
455
Excel Vers. ve Dili
2010 Tr
Altın Üyelik Bitiş Tarihi
12-10-2028
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

Altın Üye
Katılım
12 Kasım 2004
Mesajlar
455
Excel Vers. ve Dili
2010 Tr
Altın Üyelik Bitiş Tarihi
12-10-2028
Sevgili arkadaşlar bu sorunumun bir çözümü varmı acaba?
 

Levent Menteşoğlu

Administrator
Yönetici
Admin
Katılım
13 Ekim 2004
Mesajlar
16,057
Excel Vers. ve Dili
Excel 2010-32 bit-Türkçe
Excel 365 -32 bit-Türkçe
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

Altın Üye
Katılım
12 Kasım 2004
Mesajlar
455
Excel Vers. ve Dili
2010 Tr
Altın Üyelik Bitiş Tarihi
12-10-2028
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

Administrator
Yönetici
Admin
Katılım
13 Ekim 2004
Mesajlar
16,057
Excel Vers. ve Dili
Excel 2010-32 bit-Türkçe
Excel 365 -32 bit-Türkçe
Kodu thisworkbook sayfasına değil çalışmasını istediğiniz sayfanın kod sayfasına kopyalayacaksınız.
 
Üst