CheckBox True da renklendirme alanı belirleme

[ILHAREFF]

Merhaba Arkadaşlar,

Aşağıda ki koda CheckBox True olduğunda CheckBox ın olduğu satır "A13:R13" kadar renklendirmeyi nasıl yapabilirim ayrıca "R13" KONTROL EDİLDİ yazısını hücreye nasıl yazdırabilirim. Haliyle bu işlemi de sayfada bulunan bütün CheckBox larda olması gerekiyor. İlgileriniz için şimdiden teşekkür ediyorum.



For i = 13 To Cells(Rows.Count, 2).End(3).Row
If Cells(i, "b") <> "" O zaman
Hcr = Hücreleri Ayarla(i, "a")
Set Kontrol = ActiveSheet.CheckBoxes.Add(Hcr.Left, Hcr.Top, Hcr.Width, Hcr.Height)
Check.Caption = ""
Bitir
Sonraki

 

[Levent Menteşoğlu]

Örnek bir dosya ekleyin.

 

[ILHAREFF]

Örnek bir dosya ekleyin.
[/ALINTI]

Levet bey örnek dosyayı nereden ekleyebilirim

 

[Levent Menteşoğlu]

Bir dosya paylaşım sitesine ekleyip link verebilirsiniz.

 

[ILHAREFF]

Bir dosya paylaşım sitesine ekleyip link verebilirsiniz.

Levent bey çalışmam aşağıdaki linktedir.

Lifebox Transfer: Upload File! Send and Share Large Files

Lifeboxtransfer is a fast file transfer service for sharing your files easily without membership. Click and start sharing your files fast and easily with lifeboxtransfer.

lifeboxtransfer.com

 

[Levent Menteşoğlu]

Dosyanız aşağıdaki linktedir. Direk checkboxlara basarak deneyebilirsiniz.

CHECKBOX

 

[ILHAREFF]

Dosyanız aşağıdaki linktedir. Direk checkboxlara basarak deneyebilirsiniz.

CHECKBOX

Levent hocam bu çalışmayı Checkbox ile değilde satıra çift tıklama ile renklendirebilirmiyim aynı şekilde.

 

[Levent Menteşoğlu]

Levet hocam bu çalışmayı Checkbox ile değilde satıra çift tıklama ile reklendirebilirmiyi aynı şekolde.

Aşağıdaki kodu sayfanın kod sayfasına kopyalayın. A13:A1000 arasındaki hücrelere çift tıkladığınızda çalışır.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, Range("A13:A1000")) Is Nothing Then Exit Sub
Cancel = True
satirno = Target.Row
If Cells(satirno, "A").Interior.Color = 5287936 Then
Range("A" & satirno & ":K" & satirno).Interior.Color = xlNone
Range("L" & satirno).ClearContents
Else
Range("A" & satirno & ":K" & satirno).Interior.Color = 5287936
Range("L" & satirno) = "KONTROL EDİLDİ"
End If
End Sub

 

[ILHAREFF]

Aşağıdaki kodu sayfanın kod sayfasına kopyalayın. A13:A1000 arasındaki hücrelere çift tıkladığınızda çalışır.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, Range("A13:A1000")) Is Nothing Then Exit Sub
Cancel = True
satirno = Target.Row
If Cells(satirno, "A").Interior.Color = 5287936 Then
Range("A" & satirno & ":K" & satirno).Interior.Color = xlNone
Range("L" & satirno).ClearContents
Else
Range("A" & satirno & ":K" & satirno).Interior.Color = 5287936
Range("L" & satirno) = "KONTROL EDİLDİ"
End If
End Sub

Teşekkürler Levent hocam emeğinize sağlık.