Soru Otomatik Onay Kutusu Ekleme

[serkanhzl]

Merhabalar,
Alt alta işlediğim bir tablo var. İstiyorum ki B26'ya yeni bir veri eklediğimde D26'ya otomatik onay kutusunu devam ettirsin. Tablo aşağıdadır.

 

[volki_112]

Merhabalar,
Alt alta işlediğim bir tablo var. İstiyorum ki B26'ya yeni bir veri eklediğimde D26'ya otomatik onay kutusunu devam ettirsin. Tablo aşağıdadır.

dosyanı dosya.tc dosya.co gibi paylaşım sitesine yükleyip link veriniz.

 

[serkanhzl]

dosyanı dosya.tc dosya.co gibi paylaşım sitesine yükleyip link veriniz.

Buyurun, ekledim. Link:

 

[sehzade42]

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim chkBox As CheckBox
    Dim ws As Worksheet
    Dim cell As Range
    Dim tCell As Range
    
    Set ws = Me ' Aktif çalışma sayfası
    
    ' Eğer değişiklik B sütununda değilse çık
    If Intersect(Target, Me.Columns("B")) Is Nothing Then Exit Sub
    
    Application.EnableEvents = False ' Döngü hatalarını önlemek için
    
    For Each cell In Target
        ' T sütunundaki ilgili hücreyi belirle
        Set tCell = Me.Cells(cell.Row, "T")
        
        ' Eğer B hücresine veri girildiyse ve T sütununda onay kutusu yoksa ekle
        If cell.Value <> "" Then
            ' Önce varsa eski onay kutusunu temizle
            For Each chkBox In ws.CheckBoxes
                If chkBox.TopLeftCell.Address = tCell.Address Then chkBox.Delete
            Next chkBox
            
            ' Onay kutusunu ekleyip ortalama
            Set chkBox = ws.CheckBoxes.Add(tCell.Left + (tCell.Width / 2) - 6, tCell.Top + (tCell.Height / 2) - 6, 12, 12)
            With chkBox
                .Caption = "" ' Etiket gizli
                .LinkedCell = "" ' DOĞRU/YANLIŞ ifadelerini gizlemek için bağlamayı kaldır
                .Placement = xlMoveAndSize ' Hücreyle birlikte hareket etsin
            End With
            
            ' Hücre biçimlendirmesi (DOĞRU/YANLIŞ ifadelerini tamamen görünmez yapma)
            With tCell
                .HorizontalAlignment = xlCenter ' Yatay ortalama
                .VerticalAlignment = xlCenter ' Dikey ortalama
                .Font.Bold = True ' Kalın yap
                .NumberFormat = ";" ' Hücrede DOĞRU/YANLIŞ yazmasını engelle
            End With
        Else
            ' B sütunu boşsa, varsa onay kutusunu kaldır
            For Each chkBox In ws.CheckBoxes
                If chkBox.TopLeftCell.Address = tCell.Address Then chkBox.Delete
            Next chkBox
        End If
    Next cell
    
    Application.EnableEvents = True ' Olayları yeniden etkinleştir

End Sub

Yapay zeka ile bir çözüm sağladım gibi.