ListBox çoklu seçime göre çoklu veri aktarma.

[Hakan ERDOST]

Form üzerinden öğrencilere verdiğim ödevleri takip sayfası için; Listboxtan çoklu öğrenci seçimi yapıyorum bu öğrencilere seçtiğim ders, konu ve kazanıma ait ödevleri aktarmak istiyorum. Aşağıdaki kod ile tekli olarak veri aktarıyorum, Seçtiğim tüm öğrencilere aynı ödevi vermek için kodda nasıl bir revize yapmalı?..

Private Sub CommandButton5_Click()
Sheets("ÖDEV_VERİTABANI").Visible = True

Sheets("ÖDEV_VERİTABANI").Select
If Trim(ListBox2.Value) = "" Then
  Me.ListBox2.SetFocus
  MsgBox "Lütfen çoklu ÖĞRENCİ seçin"
  Exit Sub
End If
If Trim(ComboBox2.Value) = "" Then
  Me.ComboBox2.SetFocus
  MsgBox "Lütfen  ödev vereceğiniz DERSİ seçin"
  Exit Sub
End If
If Trim(ComboBox4.Value) = "" Then
  Me.ComboBox4.SetFocus
  MsgBox "Lütfen bir KONU seçin"
  Exit Sub
End If
If Trim(ComboBox5.Value) = "" Then
  Me.ComboBox5.SetFocus
  MsgBox "Lütfen  konuya ait bir KAZANIM seçin"
  Exit Sub
End If
If Range("A2") = "" Then
Range("A2").Select
ActiveCell = 1
ActiveCell.Offset(0, 1).Value = ListBox2.List
ActiveCell.Offset(0, 2).Value = ComboBox2.Value
ActiveCell.Offset(0, 3).Value = ComboBox4.Value
ActiveCell.Offset(0, 4).Value = ComboBox5.Value
ActiveCell.Offset(0, 5).Value = TextBox3.Value
ActiveCell.Offset(0, 6).Value = TextBox4.Value
ActiveCell.Offset(0, 7).Value = ComboBox3.Value

Else
[a65536].End(xlUp).Offset(1, 0).Select
ActiveCell = ActiveCell.Offset(-1, 0) + 1

ActiveCell.Offset(0, 1).Value = ListBox2.List
ActiveCell.Offset(0, 2).Value = ComboBox2.Value
ActiveCell.Offset(0, 3).Value = ComboBox4.Value
ActiveCell.Offset(0, 4).Value = ComboBox5.Value
ActiveCell.Offset(0, 5).Value = TextBox3.Value
ActiveCell.Offset(0, 6).Value = TextBox4.Value
ActiveCell.Offset(0, 7).Value = ComboBox3.Value
 
End If

ComboBox2 = ""
ComboBox4 = ""
ComboBox5 = ""
TextBox3 = ""
TextBox4 = ""
ComboBox3 = ""
    MsgBox "Kayıt işlemi tamamlanmıştır.", vbInformation, "Kayıt İşlemi"
UserForm_Initialize

Sheets("ÖDEV_VERİTABANI").Select
ActiveWindow.SelectedSheets.Visible = False
End Sub

 

[PLİNT]

Merhaba
Aşağıdaki gibi denermisiniz?

[SIZE="2"]Private Sub UserForm_Initialize()
[COLOR="Red"]With ListBox2
.ListStyle = 1
.MultiSelect = 1
End With[/COLOR]


End Sub [/SIZE]

 [SIZE="2"]Private Sub CommandButton5_Click()
Sheets("ÖDEV_VERİTABANI").Visible = True
Sheets("ÖDEV_VERİTABANI").Select
say = 0
For i = 0 To ListBox2.ListCount - 1
If ListBox2.Selected(i) = True Then say = say + 1
Next
If say = 0 Then
  Me.ListBox2.SetFocus
  MsgBox "Lütfen çoklu ÖĞRENCİ seçin"
  Exit Sub
End If
If Trim(ComboBox2.Value) = "" Then
  Me.ComboBox2.SetFocus
  MsgBox "Lütfen  ödev vereceğiniz DERSİ seçin"
  Exit Sub
End If
If Trim(ComboBox4.Value) = "" Then
  Me.ComboBox4.SetFocus
 MsgBox "Lütfen bir KONU seçin"
  Exit Sub
End If
If Trim(ComboBox5.Value) = "" Then
  Me.ComboBox5.SetFocus
  MsgBox "Lütfen  konuya ait bir KAZANIM seçin"
  Exit Sub
End If
s = IIf(Range("A2") = "", 1, [a65536].End(xlUp).Row)
For i = 0 To ListBox2.ListCount - 1
If ListBox2.Selected(i) = True Then
s = s + 1
Cells(s, 1) = s - 1
Cells(s, 2) = ListBox2.List(i)
Cells(s, 3).Value = ComboBox2.Value
Cells(s, 4).Value = ComboBox4.Value
Cells(s, 5).Value = ComboBox5.Value
Cells(s, 6).Value = TextBox3.Value
Cells(s, 7).Value = TextBox4.Value
Cells(s, 8).Value = "ComboBox3.Value"
ListBox2.Selected(i) = False
End If
Next
ComboBox2 = ""
ComboBox4 = ""
ComboBox5 = ""
TextBox3 = ""
TextBox4 = ""
ComboBox3 = ""
    MsgBox "Kayıt işlemi tamamlanmıştır.", vbInformation, "Kayıt İşlemi"
UserForm_Initialize

Sheets("ÖDEV_VERİTABANI").Select
ActiveWindow.SelectedSheets.Visible = False
End Sub [/SIZE]

 

[Hakan ERDOST]

Dim say As Integer, i As Integer, S As Integer

ilavesi ile hatasız çalıştı. İlginiz için teşekkürler.

 

[Solaq]

Üstadım bu konuyu detaylı nasıl öğrenebiliriz, list boxta tamamını seçme veya seçimleri iptal etme gibi durumlara ihtiyacım var.