onay kutusu toplu seçim

[kesikbey]

Arkadaşlar , kIRMIZI BUTONU seçtiğimde, A SÜTÜNINDAKİ bütün onay kutuları seçilsin seçilsin true olsun istiyorum, kırmızı butonu iptal ettiğimde hepsi false olsun,
mümkünse ...
şimdiden tşkrler ...

 

[Orion1]

Dosyanız ektedir.

Sub OnayKutusu62_Tıklat()
Dim i As Byte
Range("A5:A62").Value = Range("A2")
End Sub

 

[kesikbey]

Dosyanız ektedir.

Sub OnayKutusu62_Tıklat()
Dim i As Byte
Range("A5:A62").Value = Range("A2")
End Sub

HOCAM çok tşkr ederim. Güzel olmuş, ama dünya felekte bu seçim yaptığımızda,
sadece dolu satırların onay kutusu seçilse mükemmel olur. çünkü seçtiğimiz satırları başka sayfalara atıyoruz... Selamlar...

 

[halit3]

HOCAM çok tşkr ederim. Güzel olmuş, ama dünya felekte bu seçim yaptığımızda,
sadece dolu satırların onay kutusu seçilse mükemmel olur. çünkü seçtiğimiz satırları başka sayfalara atıyoruz... Selamlar...

kod

Sub sec()
Set s1 = Sheets("RAPOR")
Dim Picture As Object
For Each Picture In s1.Shapes
If TypeName(s1.Shapes(Picture.Name).OLEFormat.Object) = "CheckBox" Then
yer = Cells(Picture.BottomRightCell.Row, Picture.BottomRightCell.Column).Address
yer1 = Cells(Picture.BottomRightCell.Row, "a").Address
If Picture.BottomRightCell.Row >= 5 And Picture.BottomRightCell.Row < 63 Then
s1.Shapes(Picture.Name).OLEFormat.Object.Height = Cells(Picture.BottomRightCell.Row, Picture.BottomRightCell.Column).Height - 2
s1.Shapes(Picture.Name).OLEFormat.Object.Top = Cells(Picture.BottomRightCell.Row, 1).Top + 2
If Cells(Picture.BottomRightCell.Row, 2).Value <> "" Then
If yer = yer1 Then
If s1.Shapes("Check Box 62").OLEFormat.Object.Value = xlOn Then
s1.Shapes(Picture.Name).OLEFormat.Object.Value = xlOn
Else
s1.Shapes(Picture.Name).OLEFormat.Object.Value = xlOff
End If
End If
End If
End If
End If
Next Picture
End Sub

 

[kesikbey]

kod

sub sec()
set s1 = sheets("rapor")
dim picture as object
for each picture ın s1.shapes
ıf typename(s1.shapes(picture.name).oleformat.object) = "checkbox" then
yer = cells(picture.bottomrightcell.row, picture.bottomrightcell.column).address
yer1 = cells(picture.bottomrightcell.row, "a").address
ıf picture.bottomrightcell.row >= 5 and picture.bottomrightcell.row < 63 then
s1.shapes(picture.name).oleformat.object.height = cells(picture.bottomrightcell.row, picture.bottomrightcell.column).height - 2
s1.shapes(picture.name).oleformat.object.top = cells(picture.bottomrightcell.row, 1).top + 2
ıf cells(picture.bottomrightcell.row, 2).value <> "" then
ıf yer = yer1 then
ıf s1.shapes("check box 62").oleformat.object.value = xlon then
s1.shapes(picture.name).oleformat.object.value = xlon
else
s1.shapes(picture.name).oleformat.object.value = xloff
end ıf
end ıf
end ıf
end ıf
end ıf
next picture
end sub

hocam tekrar tşkrler ,gönderdiğini kodlar örnek dosyada çalıştı ama, kendi çalışmamda olmadı, yinede tşkrler...

 

[kesikbey]

kod

Sub sec()
Set s1 = Sheets("RAPOR")
Dim Picture As Object
For Each Picture In s1.Shapes
If TypeName(s1.Shapes(Picture.Name).OLEFormat.Object) = "CheckBox" Then
yer = Cells(Picture.BottomRightCell.Row, Picture.BottomRightCell.Column).Address
yer1 = Cells(Picture.BottomRightCell.Row, "a").Address
If Picture.BottomRightCell.Row >= 5 And Picture.BottomRightCell.Row < 63 Then
s1.Shapes(Picture.Name).OLEFormat.Object.Height = Cells(Picture.BottomRightCell.Row, Picture.BottomRightCell.Column).Height - 2
s1.Shapes(Picture.Name).OLEFormat.Object.Top = Cells(Picture.BottomRightCell.Row, 1).Top + 2
If Cells(Picture.BottomRightCell.Row, 2).Value <> "" Then
If yer = yer1 Then
If s1.Shapes("Check Box 62").OLEFormat.Object.Value = xlOn Then
s1.Shapes(Picture.Name).OLEFormat.Object.Value = xlOn
Else
s1.Shapes(Picture.Name).OLEFormat.Object.Value = xlOff
End If
End If
End If
End If
End If
Next Picture
End Sub

hALİT BEY tşkrler ,gönderdiğini kodlar örnek dosyada çalıştı ama, kendi çalışmamda olmadı, yinede tşkrler...

 

[halit3]

hALİT BEY tşkrler ,gönderdiğini kodlar örnek dosyada çalıştı ama, kendi çalışmamda olmadı, yinede tşkrler...

Benim alıntı imzamı okudunuzmu.?

Örnek dosyanız bire bir aynı olması lazım şimdi bu kodları yeniden yazmak gerekecek.