Soru Seçime bağlı döngü

Hakan ERDOST

Destek Ekibi
Destek Ekibi
Katılım
12 Eylül 2004
Mesajlar
871
Excel Vers. ve Dili
Excel 2019 Türkçe (Ev)
Excel 2013 Türkçe (Okul)
Kod:
Private Sub CommandButton8_Click()
On Error Resume Next
Dim S1 As Worksheet, x As Byte, y As Integer, Satir As Long, Sutun As Integer
If ComboBox1 = "" Then MsgBox "Lütfen DERS giriniz!", vbCritical: Exit Sub
If ComboBox2 = "" Then MsgBox "Lütfen KONU giriniz!", vbCritical: Exit Sub
If ListBox2 = "" Then MsgBox "Lütfen KAZANIM giriniz!", vbCritical: Exit Sub
If TextBox1 = "" Then MsgBox "Lütfen tarih giriniz!", vbCritical: Exit Sub
If TextBox2.Text = Empty Then MsgBox ("ListBoxtan Kazanım için Seçim yapmadınız.Kazanım Listesine çift tıklayınız."), vbInformation: Exit Sub

Set S1 = Sheets("Kazanim_Takip")
    Sutun = 8
    a = 1
        k = IIf(Range("e2") = "", 5, [e65536].End(xlUp).Row)
        Satir = IIf(Range("a2") = "", 1, [a65536].End(xlUp).Row)
            For y = 0 To ListBox2.ListCount - 1
                For x = 1 To 20         
                            With UserForm53
               If Me.Controls("CheckBox" & x) = True And ListBox2.Selected(y) = True Then
                Satir = Satir + 1
            S1.Cells(Satir, 1) = Satir - 1
            S1.Cells(Satir, 3) = ComboBox20.Value
            S1.Cells(Satir, 2) = Me.Controls("ad" & x).Caption
            S1.Cells(Satir, 4) = ComboBox1.Value
            S1.Cells(Satir, 5) = ComboBox2.Value
            S1.Cells(Satir, 7) = CDate(TextBox1.Value)
            k = k + 1
            S1.Cells(k, 6) = ListBox2.List(y)
            For Lbl = 1 To Sutun
            If UserForm53.Controls("OptionButton" & a) = False And _
            UserForm53.Controls("OptionButton" & a + 1) = False And _
            UserForm53.Controls("OptionButton" & a + 2) = False Then
            cevap = 0
        Else
            With UserForm53
                If .Controls("OptionButton" & a) = True Then cevap = 1
                If .Controls("OptionButton" & a + 1) = True Then cevap = 2
                If .Controls("OptionButton" & a + 2) = True Then cevap = 3
            End With
        End If
         S1.Cells(Satir, Sutun) = cevap
            Next
            a = a + 3
            Sutun = 8
            End If
            End With
            Next
            Next
           
    For Lbl = 1 To sutsayısı * 3
    With UserForm53
        .Controls("Optionbutton" & Lbl) = False
    End With
            Next
    S1.Columns.AutoFit
    Set S1 = Nothing
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
    UserForm_Initialize
ComboBox21.Value = ""
ListBox2.Clear
End Sub
Günaydın herkese. Bu kod ile döngüler ile nesnelerden combobox,listbox ve texboxlardaki verileri aktarabiliyorken optionbutton seçimlerini tek bir döngüde aktarıyor, listbox2 seçimi 2 ve fazlası olduğu zaman değer nesneler aktrılırken optionbuttonlar hatalı dğer döndürüyor.
 
Üst