Aylık yemek mönü

[sahika51]

İyi günler. Arkadaşlar Aylık yemek mönü programı yapmaya çalışıyorum
A Sütununa koyduğum label ile userform açılıyor. Formda bulunan KAYDET butonu bastıktan sonra kayıt yapıyor. Buraya kadar sorun yok.
1-kayıt yaptıktan sonra listboxlar da bulunan işaretli kutuların işaretinin kaldırılması gerekiyor
2-kayıt yaptıktan sonra Çalışma sayfasında bir sonraki satıra atlasın istiyorum.
çünkü her seferinde Formu açıp kapatmak zorunda kalıyorum.

Private Sub CommandButton1_Click()
ActiveCell.Offset(0, 2) = ""
If ActiveCell.Offset(0, 2) = "" Then
For a = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(a) = True Then
ActiveCell.Offset(0, 2) = ActiveCell.Offset(0, 2) & ListBox1.List(a) & ", "
End If
Next
x = Len(ActiveCell.Offset(0, 2)) - 1
ActiveCell.Offset(0, 3) = Mid(ActiveCell.Offset(0, 2), 1, x)
Else
ActiveCell.Offset(0, 2) = ActiveCell.Offset(0, 2) & ","
For a = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(a) = True Then
ActiveCell.Offset(0, 2) = ActiveCell.Offset(0, 2) & ListBox1.List(a) & ", "
End If
Next
x = Len(ActiveCell.Offset(0, 2)) - 1
ActiveCell.Offset(0, 2) = Mid(ActiveCell.Offset(0, 2), 1, x)
End If
ActiveCell.Offset(0, 3) = ""
If ActiveCell.Offset(0, 4) = "" Then
For b = 0 To ListBox2.ListCount - 1
If ListBox2.Selected(b) = True Then
ActiveCell.Offset(0, 3) = ActiveCell.Offset(0, 3) & ListBox2.List(b) & ", "
End If
Next
x = Len(ActiveCell.Offset(0, 3)) - 1
ActiveCell.Offset(0, 3) = Mid(ActiveCell.Offset(0, 3), 1, x)
Else
ActiveCell.Offset(0, 3) = ActiveCell.Offset(0, 3) & ","
For b = 0 To ListBox2.ListCount - 1
If ListBox1.Selected(b) = True Then
ActiveCell.Offset(0, 3) = ActiveCell.Offset(0, 3) & ListBox2.List(b) & ", "
End If
Next
x = Len(ActiveCell.Offset(0, 3)) - 1
ActiveCell.Offset(0, 3) = Mid(ActiveCell.Offset(0, 3), 1, x)
End If
ActiveCell.Offset(0, 4) = ""
If ActiveCell.Offset(0, 4) = "" Then
For c = 0 To ListBox3.ListCount - 1
If ListBox3.Selected(c) = True Then
ActiveCell.Offset(0, 4) = ActiveCell.Offset(0, 4) & ListBox3.List(c) & ", "
End If
Next
x = Len(ActiveCell.Offset(0, 4)) - 1
ActiveCell.Offset(0, 4) = Mid(ActiveCell.Offset(0, 4), 1, x)
Else
ActiveCell.Offset(0, 4) = ActiveCell.Offset(0, 4) & ","
For c = 0 To ListBox3.ListCount - 1
If ListBox3.Selected(c) = True Then
ActiveCell.Offset(0, 4) = ActiveCell.Offset(0, 4) & ListBox3.List(c) & ", "
End If
Next
x = Len(ActiveCell.Offset(0, 4)) - 1
ActiveCell.Offset(0, 4) = Mid(ActiveCell.Offset(0, 4), 1, x)
End If
ActiveCell.Offset(0, 5) = ""
If ActiveCell.Offset(0, 5) = "" Then
For d = 0 To ListBox4.ListCount - 1
If ListBox4.Selected(d) = True Then
ActiveCell.Offset(0, 5) = ActiveCell.Offset(0, 5) & ListBox4.List(d) & ", "
End If
Next
x = Len(ActiveCell.Offset(0, 5)) - 1
ActiveCell.Offset(0, 5) = Mid(ActiveCell.Offset(0, 5), 1, x)
Else
ActiveCell.Offset(0, 5) = ActiveCell.Offset(0, 5) & ","
For d = 0 To ListBox4.ListCount - 1
If ListBox4.Selected(d) = True Then
ActiveCell.Offset(0, 6) = ActiveCell.Offset(0, 5) & ListBox4.List(d) & ", "
End If
Next
x = Len(ActiveCell.Offset(0, 5)) - 1
ActiveCell.Offset(0, 5) = Mid(ActiveCell.Offset(0, 5), 1, x)
End If

End Sub

 

[pitchoute]

Merhaba, deneyip sonucu paylaşabilir misiniz;

Private Sub CommandButton1_Click()
    ActiveCell.Offset(0, 2) = ""
    For a = 0 To ListBox1.ListCount - 1
        If ListBox1.Selected(a) = True Then
            ActiveCell.Offset(0, 2) = ActiveCell.Offset(0, 2) & ListBox1.List(a) & ", "
        End If
    Next a
    If Len(ActiveCell.Offset(0, 2)) > 0 Then
        ActiveCell.Offset(0, 2) = Left(ActiveCell.Offset(0, 2), Len(ActiveCell.Offset(0, 2)) - 2)
    End If
    ActiveCell.Offset(0, 3) = ""
    For b = 0 To ListBox2.ListCount - 1
        If ListBox2.Selected(b) = True Then
            ActiveCell.Offset(0, 3) = ActiveCell.Offset(0, 3) & ListBox2.List(b) & ", "
        End If
    Next b
    If Len(ActiveCell.Offset(0, 3)) > 0 Then
        ActiveCell.Offset(0, 3) = Left(ActiveCell.Offset(0, 3), Len(ActiveCell.Offset(0, 3)) - 2)
    End If
    ActiveCell.Offset(0, 4) = ""
    For c = 0 To ListBox3.ListCount - 1
        If ListBox3.Selected(c) = True Then
            ActiveCell.Offset(0, 4) = ActiveCell.Offset(0, 4) & ListBox3.List(c) & ", "
        End If
    Next c
    If Len(ActiveCell.Offset(0, 4)) > 0 Then
        ActiveCell.Offset(0, 4) = Left(ActiveCell.Offset(0, 4), Len(ActiveCell.Offset(0, 4)) - 2)
    End If
    ActiveCell.Offset(0, 5) = ""
    For d = 0 To ListBox4.ListCount - 1
        If ListBox4.Selected(d) = True Then
            ActiveCell.Offset(0, 5) = ActiveCell.Offset(0, 5) & ListBox4.List(d) & ", "
        End If
    Next d
    If Len(ActiveCell.Offset(0, 5)) > 0 Then
        ActiveCell.Offset(0, 5) = Left(ActiveCell.Offset(0, 5), Len(ActiveCell.Offset(0, 5)) - 2)
    End If
    Dim i As Long
    For i = 0 To ListBox1.ListCount - 1
        ListBox1.Selected(i) = False
    Next i
    For i = 0 To ListBox2.ListCount - 1
        ListBox2.Selected(i) = False
    Next i
    For i = 0 To ListBox3.ListCount - 1
        ListBox3.Selected(i) = False
    Next i
    For i = 0 To ListBox4.ListCount - 1
        ListBox4.Selected(i) = False
    Next i
    ActiveCell.Offset(1, 0).Select
End Sub