Seçenek Düğmeleri Oluşturmak

[hilmi0707]

Arkadaşlar sorunum ekte.
Özet olarak excele eklediğim seçenek düğmelerinin hücre bağlantısını ayrı ayrı yapamıyorum. Yani 10 tane de seçenek düğmesi olsa hepsinin hücre bağlantısı tek oluyor. Ayrı ayrı hücre tanımlayamıyorum. Öğrenci cevap anahtarı için her dört seçenek düğmesini bir hücreye atamam gerekiyor.

Yardımcı olursanız sevinirim. İyi çalışmalar.

 

[hilmi0707]

teşekkür ederim.

 

[hamitcan]

Örnek dosya ekleyin.

 

[hilmi0707]

evet hocam özür dilerim. eki unuttum.

 

[hamitcan]

Sub DortSecenekliDugmeYapma()
    Dim s As Integer
    Dim i As Integer
    Dim ii As Integer
    Dim j As Integer
    Dim k As Integer
    Dim a As Long
    Dim b As Long
    Dim dd As Object
    s = InputBox("Dört Seçenekli Kaç Düğme Yapmak İstiyor Sunuz ?")
    
    Application.ScreenUpdating = False
    Rows("" & ActiveCell.Row & ":" & ActiveCell.Row + s & "").RowHeight = 15
    
    With Sayfa2

       .OLEObjects.Delete
        b = ActiveCell.Top
            For i = 1 To s
            a = ActiveCell.Left
                    For j = 1 To 4
                        a = a + 50
                        
                      Set dd = .OLEObjects.Add(ClassType:="Forms.optionButton.1", _
                            Link:=False, DisplayAsIcon:=False, Left:=a, Top:=b, _
                            Width:=30, Height:=20)
                    Next
            b = b + 14
            Next
        
        For ii = 1 To s * 4
                k = k + 1
            .OLEObjects(ii).Object.Caption = "A"
            .OLEObjects(ii).Object.GroupName = k
                ii = ii + 1
            .OLEObjects(ii).Object.Caption = "B"
            .OLEObjects(ii).Object.GroupName = k
                ii = ii + 1
            .OLEObjects(ii).Object.Caption = "C"
            .OLEObjects(ii).Object.GroupName = k
                ii = ii + 1
            .OLEObjects(ii).Object.Caption = "D"
            .OLEObjects(ii).Object.GroupName = k
        Next
    End With
    Application.ScreenUpdating = True
    
End Sub
Sub SonuclariBul()
Cells.ClearContents
c = Sayfa2.OLEObjects(1).BottomRightCell.Row - 2
For i = 1 To Sayfa2.OLEObjects.Count Step 4
For j = i To i + 3
    If Sayfa2.OLEObjects(j).Object.Value = True Then
        c = c + 1
        Cells(c, "j") = Sayfa2.OLEObjects(j).Object.Caption
    End If
Next
Next
End Sub