DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
İlk sorunuzda textbox demişsiniz.commandbutton ile 20 adet checkboxu döngü ile işaretlemek istiyorum
Private Sub CommandButton1_Click()
Dim i As Byte
For i = 1 To 20
Me.Controls("CheckBox" & i) = True
Next i
End Sub
Private Sub CommandButton2_Click()
Dim i As Byte
For i = 1 To 20
Me.Controls("CheckBox" & i) = False
Next i
End Sub
Örnek dosya var mı ?Yardımlarınızı rica ediyorum.
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
Sub CheckBox()
Dim xChk As CheckBox
Set xChk = ActiveSheet.CheckBoxes(Application.Caller)
If xChk.Text = "TÜMÜNÜ ONAYLA" Then
git:
For Each chki In ActiveSheet.CheckBoxes
With chki
If xChk.Value <> xlOff Then
.Value = True
Else
.Value = False
End If
End With
Next
Else
For Each chkx In ActiveSheet.CheckBoxes
If chkx.Text <> "TÜMÜNÜ ONAYLA" Then
With chkx
If chkx.Value <> xlOff Then
chk = True
Else
For Each chky In ActiveSheet.CheckBoxes
If chky.Text = "TÜMÜNÜ ONAYLA" Then
chky.Value = False
Exit For
End If
Next
chk = False
Exit For
End If
End With
End If
Next
If chk = True Then GoTo git
End If
End Sub
Mahmut Bey, teşekkür ederim kod çalışıyor ancak alttaki checkbox lardan birinden onayı kaldırınca tümünü onayladaki işaretin de kalkmasını sağlayabilirmiyiz?Aşağıdaki kodu bağlayıp deneyin.
Kod: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
Emre Bey, desteğiniz için teşekkür ederim ancak şu şekilde bir hata alıyorum.Alternatif
Kod:Sub CheckBox() Dim xChk As CheckBox Set xChk = ActiveSheet.CheckBoxes(Application.Caller) If xChk.Text = "TÜMÜNÜ ONAYLA" Then git: For Each chki In ActiveSheet.CheckBoxes With chki If xChk.Value <> xlOff Then .Value = True Else .Value = False End If End With Next Else For Each chkx In ActiveSheet.CheckBoxes If chkx.Text <> "TÜMÜNÜ ONAYLA" Then With chkx If chkx.Value <> xlOff Then chk = True Else For Each chky In ActiveSheet.CheckBoxes If chky.Text = "TÜMÜNÜ ONAYLA" Then chky.Value = False Exit For End If Next chk = False Exit For End If End With End If Next If chk = True Then GoTo git End If End Sub
Merhaba gönderdiğim kodlar da "Option Explicit" satırı yoktu o satırı silerseniz çalışır. yada aşağıdaki kodlar ile deneyiniz.Emre Bey, desteğiniz için teşekkür ederim ancak şu şekilde bir hata alıyorum.
Option Explicit
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 xChk.Text = "TÜMÜNÜ ONAYLA" Then
git:
For Each chki In ActiveSheet.CheckBoxes
With chki
If xChk.Value <> xlOff Then
.Value = True
Else
.Value = False
End If
End With
Next
Else
For Each chkx In ActiveSheet.CheckBoxes
If chkx.Text <> "TÜMÜNÜ ONAYLA" Then
With chkx
If chkx.Value <> xlOff Then
chk = True
Else
For Each chky In ActiveSheet.CheckBoxes
If chky.Text = "TÜMÜNÜ ONAYLA" Then
chky.Value = False
Exit For
End If
Next
chk = False
Exit For
End If
End With
End If
Next
If chk = True Then GoTo git
End If
End Sub
Set xChk = ActiveSheet.CheckBoxes(Application.Caller)