Onay Kutusu Seçme

[karanx]

onay kutularından herhangibiri seçiliyken diğeri seçilmesin istiyorum.bu mümkün müdür ? Teşekkürler.

 

[Orion1]

Seçenek düğmesi kullanınız.

 

[karanx]

Seçenek düğmesi kullanınız.

düşünmedi değilim ama , herşeyi bunun üzerine kurdum geri dönmek zor geliyor

 

[Orion1]

Zaten bu işin en önemli yanıda budur.
Kod yazmak falan değildir.
Eğer kodda sıkıntı yaşarsınız,araştırıp bulursunuz.
Ama tasarım öylemi ya.
Bu tamamen sizin maharetinize kalmış.
Siz ve tasarımıznız.İşte Bu konuda siz yalnızsınız.
Siz koyuna çalıyı atlatma,yani keçinin yaptığı işi yaptırmak istiyorsunuz.
Oysa keçiye bu işe yaptırmak varken.Bu iş keçiye yakışır diilmi.

 

[karanx]

Evet haklısınız..

 

[karanx]

Seçenek gibi kullanılabilen onay kutusu

İnat ettim çözdüm sonunda... İşine yarayacak arkadaşlar için yeni dosyayı ekliyorum.

 

[halit3]

İnat ettim çözdüm sonunda... İşine yarayacak arkadaşlar için yeni dosyayı ekliyorum.

Bu durumlarda en iyisi seçenek düğmesini kullanmak gerek illaki onay kutusu kullanılacaksa aşağıdaki kodu bir adet onay kutusuna bağlayın ve üstüne tıklayın diğer onay kutularındada aynı kod çalışacaktır.

kod:

Sub sutun105()
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
S1.Shapes(Picture.Name).OLEFormat.Object.Value = xlOff
S1.Shapes(Picture.Name).OLEFormat.Object.OnAction = "sutun105"
End If
Next Picture
ActiveSheet.Shapes(Application.Caller).Select
ActiveSheet.Shapes(Application.Caller).OLEFormat.Object.Value = xlOn
sut = ActiveSheet.Shapes(Application.Caller).BottomRightCell.Column
sat = ActiveSheet.Shapes(Application.Caller).BottomRightCell.Row
Cells(sat, sut).Select
End Sub

 

[karanx]

Bu durumlarda en iyisi seçenek düğmesini kullanmak gerek illaki onay kutusu kullanılacaksa aşağıdaki kodu bir adet onay kutusuna bağlayın ve üstüne tıklayın diğer onay kutularındada aynı kod çalışacaktır.

kod:

Sub sutun105()
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
S1.Shapes(Picture.Name).OLEFormat.Object.Value = xlOff
S1.Shapes(Picture.Name).OLEFormat.Object.OnAction = "sutun105"
End If
Next Picture
ActiveSheet.Shapes(Application.Caller).Select
ActiveSheet.Shapes(Application.Caller).OLEFormat.Object.Value = xlOn
sut = ActiveSheet.Shapes(Application.Caller).BottomRightCell.Column
sat = ActiveSheet.Shapes(Application.Caller).BottomRightCell.Row
Cells(sat, sut).Select
End Sub

Alternatif çözüm için teşekkürler , lakin benim yapmak istediğim şey farklı...Aynı sütunda bulunanlar bağımsız işaretlenebilmeli ,birini check ettiğim zaman altındaki veya üstündeki checkler kalkmayacak..Satırlar içinse tam tersi ;aynı satırda bulunan onay kutularından sadece bir tanesi check edilebilir olmalı...Ben bunu yukarda kendi denemelerimle çözdüm...tek sorun şu : çok fazla onay kutusu kullanacağımdan hepsine ayrı makro yazmak ve atamak zor bir işlem..şimdilik 150 tane onay kutusu var ve uğraştım tek tek atadım makroları...Bu sayı artacağı içinse şimdiden korkar oldum..

 

[halit3]

Alternatif çözüm için teşekkürler , lakin benim yapmak istediğim şey farklı...Aynı sütunda bulunanlar bağımsız işaretlenebilmeli ,birini check ettiğim zaman altındaki veya üstündeki checkler kalkmayacak..Satırlar içinse tam tersi ;aynı satırda bulunan onay kutularından sadece bir tanesi check edilebilir olmalı...Ben bunu yukarda kendi denemelerimle çözdüm...tek sorun şu : çok fazla onay kutusu kullanacağımdan hepsine ayrı makro yazmak ve atamak zor bir işlem..şimdilik 150 tane onay kutusu var ve uğraştım tek tek atadım makroları...Bu sayı artacağı içinse şimdiden korkar oldum..

Böyle birşeymi istiyorsunuz.

Sub sutun105()
On Error Resume Next
Dim Picture As Object
Set s1 = Sheets(ActiveSheet.Name)
sat1 = ActiveSheet.Shapes(Application.Caller).BottomRightCell.Row
For Each Picture In s1.Shapes
If TypeName(s1.Shapes(Picture.Name).OLEFormat.Object) = "CheckBox" Then
If sat1 = s1.Shapes(Picture.Name).BottomRightCell.Row Then
s1.Shapes(Picture.Name).OLEFormat.Object.Value = xlOff
End If
s1.Shapes(Picture.Name).OLEFormat.Object.OnAction = "sutun105"
End If
Next Picture
ActiveSheet.Shapes(Application.Caller).Select
ActiveSheet.Shapes(Application.Caller).OLEFormat.Object.Value = xlOn
sut = ActiveSheet.Shapes(Application.Caller).BottomRightCell.Column
sat = ActiveSheet.Shapes(Application.Caller).BottomRightCell.Row
Cells(sat, sut).Select
End Sub

Ayrıca aşağıdaki linkdede bu durum gruplandırılıyor.

http://www.excel.web.tr/f50/z-ld-checkboxes-cell-link-copy-paste-sorunu-t125994.html

 

[karanx]

Böyle birşeymi istiyorsunuz.

Sub sutun105()
On Error Resume Next
Dim Picture As Object
Set s1 = Sheets(ActiveSheet.Name)
sat1 = ActiveSheet.Shapes(Application.Caller).BottomRightCell.Row
For Each Picture In s1.Shapes
If TypeName(s1.Shapes(Picture.Name).OLEFormat.Object) = "CheckBox" Then
If sat1 = s1.Shapes(Picture.Name).BottomRightCell.Row Then
s1.Shapes(Picture.Name).OLEFormat.Object.Value = xlOff
End If
s1.Shapes(Picture.Name).OLEFormat.Object.OnAction = "sutun105"
End If
Next Picture
ActiveSheet.Shapes(Application.Caller).Select
ActiveSheet.Shapes(Application.Caller).OLEFormat.Object.Value = xlOn
sut = ActiveSheet.Shapes(Application.Caller).BottomRightCell.Column
sat = ActiveSheet.Shapes(Application.Caller).BottomRightCell.Row
Cells(sat, sut).Select
End Sub

Ayrıca aşağıdaki linkdede bu durum gruplandırılıyor.

http://www.excel.web.tr/f50/z-ld-checkboxes-cell-link-copy-paste-sorunu-t125994.html

Hay Allah razı olsun üstadım , beni büyük bir müşkülden kurtardınız...Elinize kolunuza sağlık...

 

[halit3]

Hay Allah razı olsun üstadım , beni büyük bir müşkülden kurtardınız...Elinize kolunuza sağlık...

Teşekkürler iyi çalışmalar