Onay kutusu çoğaltma

[bysabo]

Merhaba,

Checkbox'ları çoğalttığım zaman bağlı bulunduğu hücre değişmiyor.

Örneğin C16'ya bağladığım hücreyi tutup aşağı doğru çektiğimde C30'a kadar checkbox oluşuyor ancak bu checkboxların hepsi C16'a bağlı şekilde oluşuyor. C17, C18 şeklinde sıralanmıyor. Mecburen hepsini tek tek elimle düzeltiyorum. Bunun bir yolu var mı ?

 

[Levent Menteşoğlu]

Checkboxları form denetimlerinden eklediğinizi düşünürsek aşağıdaki kodu deneyebilirsiniz. Bu kodu checkboxları çoğalttıktan sonra çalıştırın.

Sub hucre_adreslerini_bagla()

For Each nesne In ActiveSheet.DrawingObjects

If TypeName(nesne) = "CheckBox" Then

nesne.LinkedCell = nesne.TopLeftCell.Offset.Address

End If

Next

End Sub

 

[Necdet]

Alternatif, ChatCpt'nin kodları
Belirli aralıkta checkbox eklemek.

Sub OnayKutusuEkle()

    Dim ws As Worksheet
    Dim cb As CheckBox
    Dim hücre As Range
    Dim Top As Single, Left As Single
    Dim i As Integer
    
    ' Çalışmak istediğiniz sayfayı belirtin
    Set ws = ThisWorkbook.Sheets("Sayfa1") ' Sayfa adını değiştirin
    
    ' Onay kutularını eklemek istediğiniz hücre aralığını belirtin
    Set hücre = ws.Range("C4:C20") ' Hücre aralığını gerektiğine göre değiştirin
    
    Top = hücre.Top
    Left = hücre.Left
    
    ' Hücre aralığını dolaşın ve her hücreye bir onay kutusu ekleyin
    For i = 1 To hücre.Cells.Count
        Set cb = ws.CheckBoxes.Add(Left, Top, 50, 15) ' Kutu boyutunu ve konumunu ayarlayın
        With cb
            .LinkedCell = hücre.Cells(i).Address
            .Display3DShading = False
            .Caption = ""
            .Name = "CheckBox_" & i
        End With
        Top = Top + 15 ' Sonraki kutu için yukarı kaydırın
    Next i
End Sub

 

[bysabo]

Teşekkürler.

 

[Ercan_ÇELİKOĞLU]

Alternatif, ChatCpt'nin kodları
Belirli aralıkta checkbox eklemek.

Sub OnayKutusuEkle()

    Dim ws As Worksheet
    Dim cb As CheckBox
    Dim hücre As Range
    Dim Top As Single, Left As Single
    Dim i As Integer
   
    ' Çalışmak istediğiniz sayfayı belirtin
    Set ws = ThisWorkbook.Sheets("Sayfa1") ' Sayfa adını değiştirin
   
    ' Onay kutularını eklemek istediğiniz hücre aralığını belirtin
    Set hücre = ws.Range("C4:C20") ' Hücre aralığını gerektiğine göre değiştirin
   
    Top = hücre.Top
    Left = hücre.Left
   
    ' Hücre aralığını dolaşın ve her hücreye bir onay kutusu ekleyin
    For i = 1 To hücre.Cells.Count
        Set cb = ws.CheckBoxes.Add(Left, Top, 50, 15) ' Kutu boyutunu ve konumunu ayarlayın
        With cb
            .LinkedCell = hücre.Cells(i).Address
            .Display3DShading = False
            .Caption = ""
            .Name = "CheckBox_" & i
        End With
        Top = Top + 15 ' Sonraki kutu için yukarı kaydırın
    Next i
End Sub

neecdet hocam umarım görürsünüz verdiğiniz kodla check boxlar ekleniyor ama işaretleyince yanına doğru veya işaretlemeyince yanlış yazıyor ben sadece işaretlemek istesem kodda nasıl bir değişiklik gerekir. saygılarımla.

 

[Merhum İdris SERDAR]

.

Buradaki dosyaya bakınız.

https://www.excelgurusu.com/coklu-onay-kutusu-checkbox/

.

 

[Necdet]

neecdet hocam umarım görürsünüz verdiğiniz kodla check boxlar ekleniyor ama işaretleyince yanına doğru veya işaretlemeyince yanlış yazıyor ben sadece işaretlemek istesem kodda nasıl bir değişiklik gerekir. saygılarımla.

Aşağıdaki kod satırını silerseniz yeterli.

.LinkedCell = hücre.Cells(i).Address