toplu checkbox işaretleme

[EmrExcel16]

Gönderdiğim dosyda hiç sikinti yaşamiyorsunuz , ama kodları kendi dosyaniza kopyaladığinizda sikinti yaşiyorsunuz doğrumudur.

Eğer özel bilğiler içermiyorsa orjinal dosyanizi ekleyin bakalim .

 

[metalog]

Evet formatlar tamamen aynı ancak kodları kopyalayıp makro ataması yaptığım halde olmadı.

Gönderdiğiniz dosyadaki kodu biraz kurcaladım, bu sefer de biri oldu diğeri yine olmadı.

Orjinal dosya gönderme konusu ile ilgili size özelden yazdım. Çözebilirsek çözümü buradan paylaşacağım.

 

[metalog]

Sorun çözüldü.

Emre Bey'e desteğinde dolayı teşekkür ediyorum.

Aynı sorunu yaşayabilecek arkadaşlar için kodu aşağıya ekliyorum.

Sub CheckBox()
Dim xChk As CheckBox, chki As CheckBox, chkx As CheckBox, chky As CheckBox, chk As String


Set xChk = ActiveSheet.CheckBoxes(Application.Caller)

    If Left(xChk.Text, 6) = "TÜMÜNÜ" Then
        
        
        HngChk = Mid(xChk.Text, 8, Len(xChk.Text))
        
git:
        For Each chki In ActiveSheet.CheckBoxes
            If Left(chki.Text, Len(HngChk)) = HngChk Or chki.Text = "TÜMÜNÜ " & HngChk Then
                With chki
                    If xChk.Value <> xlOff Then
                        .Value = True
                    Else
                        .Value = False
                    End If
                End With
            End If
        Next
        Exit Sub
    End If
    
    HngChk = xChk.Text
    
    For Each chkx In ActiveSheet.CheckBoxes
        If chkx.Text = HngChk Or chkx.Text = "TÜMÜNÜ " & HngChk Then
            If chkx.Text <> "TÜMÜNÜ " & HngChk Then
                With chkx
                    If chkx.Value <> xlOff Then
                        chk = True
                    Else
                    
                        For Each chky In ActiveSheet.CheckBoxes
                            If chky.Text = "TÜMÜNÜ " & HngChk Then
                                chky.Value = False
                                Exit For
                            End If
                        Next
                        
                        chk = False
                        Exit For
                    End If
                End With
            End If
            
            
        End If
    
    
    Next
    If chk = True Then GoTo git
    
End Sub

 

[EmrExcel16]

Sorun çözüldü.

Emre Bey'e desteğinde dolayı teşekkür ediyorum.

Aynı sorunu yaşayabilecek arkadaşlar için kodu aşağıya ekliyorum.

Sub CheckBox()
Dim xChk As CheckBox, chki As CheckBox, chkx As CheckBox, chky As CheckBox, chk As String


Set xChk = ActiveSheet.CheckBoxes(Application.Caller)

    If Left(xChk.Text, 6) = "TÜMÜNÜ" Then
       
       
        HngChk = Mid(xChk.Text, 8, Len(xChk.Text))
       
git:
        For Each chki In ActiveSheet.CheckBoxes
            If Left(chki.Text, Len(HngChk)) = HngChk Or chki.Text = "TÜMÜNÜ " & HngChk Then
                With chki
                    If xChk.Value <> xlOff Then
                        .Value = True
                    Else
                        .Value = False
                    End If
                End With
            End If
        Next
        Exit Sub
    End If
   
    HngChk = xChk.Text
   
    For Each chkx In ActiveSheet.CheckBoxes
        If chkx.Text = HngChk Or chkx.Text = "TÜMÜNÜ " & HngChk Then
            If chkx.Text <> "TÜMÜNÜ " & HngChk Then
                With chkx
                    If chkx.Value <> xlOff Then
                        chk = True
                    Else
                   
                        For Each chky In ActiveSheet.CheckBoxes
                            If chky.Text = "TÜMÜNÜ " & HngChk Then
                                chky.Value = False
                                Exit For
                            End If
                        Next
                       
                        chk = False
                        Exit For
                    End If
                End With
            End If
           
           
        End If
   
   
    Next
    If chk = True Then GoTo git
   
End Sub

Rica ederim , iyi çalışmalar.

 

[cemsid2]

Aşağıdaki kodu bağlayıp deneyin.

Sub OnayKutusu92_Tıkla()
  Dim c As CheckBox
    For Each c In ActiveSheet.CheckBoxes
        If c.Name <> ActiveSheet.CheckBoxes("Onay Kutusu 92").Name Then
            c.Value = ActiveSheet.CheckBoxes("Onay Kutusu 92").Value
        End If
    Next
End Sub

PEKİ BİR KUTUYU SEÇİNCE BİRKAÇ KUTU AYNI ANDA OTOMATİK SEÇİLMESİ İÇİN NE YAPILABİLİR?

 

[dianysos38]

Merhaba;
Benim sorum şu olacak,
yan yana 2 onay kutucuğu biri tklanınca diğerinin tıkı kalkacak
Böyle birşey olurmu
şimdiden teşekürler

 

[RBozkurt]

Optionbuton araştırınız. Aynı frame içinde olması lazım.

 

[dianysos38]

Cevap için teşekkürler elimde çeklist listem var D sütunu Evet E sütunu Hayır
Onay kutucuğunda evet'i işaretlemişsem hayırın tiki kalkması lazım Hayri işaretlemişsem evetinki kalkması lazım
Böyle bir şey yapabilir miyim