Checkbox hepsini seç

[Baggwell]

Merhaba

Başlık kısmında checkbox seçildiğinde o tabloda bulunan alttaki checkboxların tümünün seçmesini istiyorum, forumda biraz araştırdım fakat kodları kendi tabloma göre ayarlayamadım

Forumda bulduğum örnek kod, kendi yaptığım tabloda checkbox isimlerini tutturamıyorum sanırım .)

Option Explicit
Sub ÖZEL_CHECKBOX_AKTİF()
    Dim Nesne As OLEObject
    
    For Each Nesne In ActiveSheet.OLEObjects
        If Nesne.OLEType = 2 Then
            If TypeOf Nesne.Object Is MsForms.CheckBox Then
                If Nesne.Name = "CheckBox2" Or _
                    Nesne.Name = "CheckBox5" Or _
                    Nesne.Name = "CheckBox12" Or _
                    Nesne.Name = "CheckBox18" Then
                    Nesne.Object.Value = True
                End If
            End If
        End If
    Next
End Sub

Sub CHECKBOX_PASİF()
    Dim Nesne As OLEObject
    
    For Each Nesne In ActiveSheet.OLEObjects
        If Nesne.OLEType = 2 Then
            If TypeOf Nesne.Object Is MsForms.CheckBox Then
                If Nesne.Name = "CheckBox2" Or _
                    Nesne.Name = "CheckBox5" Or _
                    Nesne.Name = "CheckBox12" Or _
                    Nesne.Name = "CheckBox18" Then
                    Nesne.Object.Value = False
                End If
            End If
        End If
    Next
End Sub

 

[halit3]

Merhaba

Eklediğiniz.nesneler hücreleri taşmamalı zira hücreden büyük olduğu zaman kodlar hata verir.

Ben bütün kodları yeniden yazdım irdeleyin.

 

[Baggwell]

Halit bey ilgilenmişsiniz teşekkür edeceğim güzel olmuş ama istediğim olmamış neden derseniz +

web sayfasından veri çekeceğim, dolayısı ile seçim 1 butonu yalnızca ilk 15 checkbox kutusunu seçiyor, web sayfasındaki veri güncellendiğinde satır sayısı belki 30 olacak artacak ama makro yine belirlediğiniz aralıktaki 15 checkboxı seçiyor anlatabildim mi

 

[halit3]

Halit bey ilgilenmişsiniz teşekkür edeceğim güzel olmuş ama istediğim olmamış neden derseniz +

web sayfasından veri çekeceğim, dolayısı ile seçim 1 butonu yalnızca ilk 15 checkbox kutusunu seçiyor, web sayfasındaki veri güncellendiğinde satır sayısı belki 30 olacak artacak ama makro yine belirlediğiniz aralıktaki 15 checkboxı seçiyor anlatabildim mi

Sub hepsinisecsatır1()
On Error Resume Next
Dim Picture As Object
Set s1 = Sheets(ActiveSheet.Name)
For Each Picture In s1.Shapes
If TypeName(s1.Shapes(Picture.Name).OLEFormat.Object) = "CheckBox" Then
[COLOR=red]If Picture.BottomRightCell.Row >= 4 And Picture.BottomRightCell.Row <= 19 Then
[/COLOR]If Picture.BottomRightCell.Column = 22 Then
s1.Shapes(Picture.Name).OLEFormat.Object.Value = xlOn
End If
[COLOR=red]End If
[/COLOR]End If
Next Picture
MsgBox "İşlem Tamam", vbInformation, " U Y A R I "
End Sub

Sizin örnek dosyanızda iki bölüm vardı ben bunları ayrı ayrı düşünmüştüm.
Yukarıdaki kodun kırmızı yerlerini silerseniz nesnelerin hepsi işaretlenecektir.
Eğer satır aralığı belirtmek isterseniz kırmızı yerde 4 ile 19 sayısı var bu sayılar nesnelerin başlangıç ve bitiş satırlarını gösteriyor bunları değiştirerekte işlem yapabilirsiniz.

 

[Baggwell]

bu seferde tümünü seçmiş oluyor, boşluğa kadar seçmesi gerekiyor anlatabildim mi acaba

 

[halit3]

bu seferde tümünü seçmiş oluyor, boşluğa kadar seçmesi gerekiyor anlatabildim mi acaba

4 nolu mesajımdaki kırmızı yazan yerde 19 sayısını değiştirmelisiniz.

yada alternatif olarak bu kodu kullanın

kod:

Sub hepsinisecsatır1()
On Error Resume Next
[COLOR=red]Dim Rng As Range[/COLOR]
[COLOR=red]With Sheets(ActiveSheet.Name).Range("A4:A" & Cells(Rows.Count, "a").End(3).Row)[/COLOR]
[COLOR=red]Set Rng = .Find(What:="", After:=.Cells(.Cells.Count), LookIn:=xlValues, lookat:=xlWhole, _[/COLOR]
[COLOR=red]SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)[/COLOR]
[COLOR=red]If Not Rng Is Nothing Then[/COLOR]
[COLOR=red]son = Rng.Row[/COLOR]
[COLOR=red]Else[/COLOR]
[COLOR=red]son = Cells(Rows.Count, "a").End(3).Row[/COLOR]
[COLOR=red]End If[/COLOR]
[COLOR=red]End With[/COLOR]
 
Dim Picture As Object
Set s1 = Sheets(ActiveSheet.Name)
For Each Picture In s1.Shapes
If TypeName(s1.Shapes(Picture.Name).OLEFormat.Object) = "CheckBox" Then
If Picture.BottomRightCell.Row >= 4 And Picture.BottomRightCell.Row <= [COLOR=red]son[/COLOR] Then
If Picture.BottomRightCell.Column = 22 Then
s1.Shapes(Picture.Name).OLEFormat.Object.Value = xlOn
End If
End If
End If
Next Picture
MsgBox "İşlem Tamam", vbInformation, " U Y A R I "
End Sub

 

[Baggwell]

halit hocam oldu teşekkür ederim iyi çalışmalar

 

[halit3]

halit hocam oldu teşekkür ederim iyi çalışmalar

Teşekkürler iyi çalışmalar