Onay butonu ile satırı boyama

[fkorkmaz]

Merhaba herkese, ben excelimde bulunan her satırın yanına ayrı ayrı buton ekleyerek her bir butona basıldığında o satırın renginin değişmesini istiyorum. Acaba nasıl yapabilirim? Yardım edebilirseniz sevinirim.

Teşekkürler şimdiden.

 

[Jeeday]

butonlar hangi sütunda bulunacak?

 

[fkorkmaz]

Öncellikle teşekkür ederim. Ben yaptığım her satırın yanında bu butonun olmasını istiyorum. Bastığımızda mesela o satır yeşil olsun yeniden tıkladığımızda da yeşil olsun istiyorum. Bir fikir de verirseniz çok sevinirim.

Dosya ekleyemediğim için gönderemiyorum örnek çalışmayı. N2 sütununa ekleyeceğim butonları.

 

[Jeeday]

Dosya ektedir...

 

[fkorkmaz]

Merhaba Jeeday, paylaşımın altın üyelik istiyor farklı bir şekilde göremez miyim?

 

[Jeeday]

mail adresinizi alayım

 

[halit3]

Alternatif kod
açıklama ilk on satırın satır yüksekliğini mesela 25 yapın ve Nesne_Ekle düğmesine tıklayınca N sütununa CheckBox nesnelerinden birinci satırdan onuncu satıra kadar oluşturacaktır. daha sonra nesneleri sırası ile seçim yapın D ve M sütun aralığını sarıya boyayacaktır.

İsterseniz Nesne_sil düğmesinden hepsini silebilirsiniz.

Aşağıdaki kırmızı yerleri kendinize göre düzenlersiniz.

Sub Nesne_Ekle()

On Error Resume Next
Set s1 = Sheets(ActiveSheet.Name)
For r = 1 To s1.Shapes.Count
If TypeName(s1.Shapes(r).OLEFormat.Object) = "CheckBox" Then
a = MsgBox("Nesneler mevcut yeniden nesneleri oluşturmak istiyorsanız" & Chr(10) & Chr(10) & _
"Nesneleri sil seçeneğine tıkladıktan sonra yeniden deneyiniz.", vbInformation, " U Y A R I ")
Exit Sub
End If
Next

sut = "[COLOR="red"]n[/COLOR]"
For r = [COLOR="red"]1 [/COLOR]To [COLOR="red"]10[/COLOR]
yer = s1.CheckBoxes.Add(1, 1, 1, 1).Name
s1.Shapes(yer).OLEFormat.Object.Top = s1.Cells(r, sut).Top + 4 ' + say
s1.Shapes(yer).OLEFormat.Object.Left = s1.Cells(r, sut).Left
s1.Shapes(yer).OLEFormat.Object.Height = s1.Cells(r, sut).Height - 8
s1.Shapes(yer).OLEFormat.Object.Width = s1.Cells(r, sut).Width
s1.Shapes(yer).OLEFormat.Object.Characters.Text = r
s1.Shapes(yer).OLEFormat.Object.Name = sut & r
's1.Shapes(yer).Select
'Selection.OnAction = "makro_ata"
s1.Shapes(yer).OLEFormat.Object.OnAction = "makro_ata"
Next r

MsgBox "İşlem Tamam", vbInformation, " U Y A R I "

End Sub


Sub Nesne_sil()
Dim Picture As Object
For Each Picture In ActiveSheet.Shapes
If TypeName(ActiveSheet.Shapes(Picture.Name).OLEFormat.Object) = "CheckBox" Then
Picture.Delete
End If
Next Picture

End Sub

Sub makro_ata()
ad = Trim(Application.Caller)

satir = Trim(ActiveSheet.Shapes(ad).OLEFormat.Object.BottomRightCell.Row)
If ActiveSheet.Shapes(ad).OLEFormat.Object = 1 Then
Range("[COLOR="Red"]D[/COLOR]" & satir & ":[COLOR="red"]M[/COLOR]" & satir).Interior.ColorIndex =[COLOR="red"] 6[/COLOR]

ActiveSheet.Shapes(ad).OLEFormat.Object.ShapeRange.Fill.Visible = msoTrue
ActiveSheet.Shapes(ad).OLEFormat.Object.ShapeRange.Fill.ForeColor.SchemeColor = [COLOR="red"]11[/COLOR]
Else
Range("[COLOR="red"]D[/COLOR]" & satir & ":[COLOR="red"]M[/COLOR]" & satir).Interior.ColorIndex = xlNone
ActiveSheet.Shapes(ad).OLEFormat.Object.ShapeRange.Fill.Visible = msoFalse
End If
End Sub