- 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