• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

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

Hakan ERDOST

Destek Ekibi
Destek Ekibi
Katılım
12 Eylül 2004
Mesajlar
885
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.
 
Geri
Üst