Kodu bir CheckBox nesnesine atamak

[Hacı Bayram ÖZKAN]

Merhaba arkadaşlar; elimdeki bir kodu

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
Cells.Interior.ColorIndex = xlColorIndexNone
ActiveCell.EntireColumn.Interior.ColorIndex = 17 'Sütun Rengi
ActiveCell.EntireRow.Interior.ColorIndex = 24 ' Satır Rengi
ActiveCell.Cells.Interior.ColorIndex = 36 ' Hücre Rengi
End Sub

Aktif ve Pasif olması için bunu bir CheckBox nesnesine nasıl bağlarım, yani çentik koyunca aktif olacak bu kod çalışacak, çentiği kaldırınca pasif olup, bu kod çalışmayacak herkese teşekkürler.

 

[ÖmerBey]

Merhaba,
Şu şekilde deneyiniz: (Kırmızı kısım onay kutusunun adı olacak)

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
If ActiveSheet.CheckBoxes("[COLOR="Red"]Onay Kutusu 1[/COLOR]").Value = 1 Then
    Cells.Interior.ColorIndex = xlColorIndexNone
    ActiveCell.EntireColumn.Interior.ColorIndex = 17 'Sütun Rengi
    ActiveCell.EntireRow.Interior.ColorIndex = 24 ' Satır Rengi
    ActiveCell.Cells.Interior.ColorIndex = 36 ' Hücre Rengi
Else
    Cells.Interior.ColorIndex = xlColorIndexNone
End If
End Sub

 

[Hacı Bayram ÖZKAN]

Sayin mucit bu kod çalışmadı. Siz bos bir dosyada denemiş miydiniz.
yoksa ben bu kodu uygulamadım mi bunu CheckBox un kod bölümüne mi
yapıştıracağım

 

[PLİNT]

Merhaba
Sn mucit77 'nin kodlarına alternatif olarak hücrelerden bağımsız olarak isterseniz:
Aşağıdaki gibi olabilir.
http://s3.dosya.tc/server7/0hkmea/onay_kt.zip.html

Çoklu "Onay Kutuları için

Sub renk()
    Set a = ActiveSheet
    Set b = a.CheckBoxes(Application.Caller)
    c = b.TopLeftCell.Row
    d = b.TopLeftCell.Column
If b.Value = xlOn Then
For Each cb In a.CheckBoxes
If Cells(c, d).Address <> Cells(cb.TopLeftCell.Row, cb.TopLeftCell.Column).Address Then
cb.Value = xlOff
End If
Next
Cells.Interior.ColorIndex = xlColorIndexNone
Cells(c, d).EntireColumn.Interior.ColorIndex = 17 'Sütun Rengi
Cells(c, d).EntireRow.Interior.ColorIndex = 24 ' Satır Rengi
Cells(c, d).Cells.Interior.ColorIndex = 36 ' Hücre Rengi
Else
Cells.Interior.ColorIndex = xlColorIndexNone
End If

End Sub

Tek "Onay Kutusu" için

Sub OnayKutusu1_Tıklat()
   Set a = ActiveSheet
    Set b = a.CheckBoxes(Application.Caller)
    c = b.TopLeftCell.Row
    d = b.TopLeftCell.Column
If b.Value = xlOn Then
Cells(c, d).EntireColumn.Interior.ColorIndex = 17 'Sütun Rengi
Cells(c, d).EntireRow.Interior.ColorIndex = 24 ' Satır Rengi
Cells(c, d).Cells.Interior.ColorIndex = 36 ' Hücre Rengi
Else
Cells.Interior.ColorIndex = xlColorIndexNone
End If

End Sub

 

[Ömer BARAN]

Merhaba.
Sayın mucit'in önerdiği kod, sizin konu açılış mesajınızdaki kod gibi Worksheet_SelectionChange türünden bir kod.
Bu nedenle, alt taraftan sayfa adına fareyle sağ tıkladığınızda açılan menüden KOD GÖDÜRTÜLEyi seçtiğinizde
açılan ekranın sağ tarafındaki boş alana yapıştırılmalıdır.

Ayrıca Sayın mucit eklediğiniz CheckBox'un FORM DENETİMLERİ bölümündeki CheckBox olduğunu varsaymış ve sorunsuz.

Ancak sayfaya eklediğiniz CheckBox Form Denetimleri bölümündeki DEĞİL ACTIVEX DENETİMLERİ bölümündeki CheckBox ise;
Sayın mucit'in verdiği kod'un başlıktan sonra If şeklinde başlayan satırını aşağıdaki şekilde değiştirerek sonuç almanız lazım.

If CheckBox1 = True Then

 

[Hacı Bayram ÖZKAN]

Merhaba arkadaşlar herkese iyi akşamlar galiba isteğimi yanlış anlatmışım, farklı yanıtlar aldım, benim hatam oldu ekli dosyamı ekledim, burada isteğimi anlattım, dosyam http://s3.dosya.tc/server7/1g8nau/DENEME_DOSYASI.xls.html buradadır, teşekkürler.

 

[Ömer BARAN]

Merhaba.
Mevcut kod'un;
-- Private Sub diye başlayan başlık satırından sonra aşağıdaki mavi satırı,
-- End Sub satırından önce de kırmızı satırları yapıştırınız.

[COLOR="Blue"]If CheckBox1 = False Then[/COLOR]

[COLOR="Red"]Else
Cells.Interior.Color = xlNone
End If[/COLOR]

 

[Hacı Bayram ÖZKAN]

Eyvallah Ömer teşekkür ederim. Sizleri rahatsız ettim iyi akşamlar. Sağlık ve dua ile kalın.

 

[Ömer BARAN]

Adıyaman'a selam olsun.
İyi günler dilerim.