Gruppe
Dialog
Problem
Über eine UserForm sollen Start- und Enddatum festgelegt und die passenden Daten in eine mehrspaltige ListBox eingelesen werden.
StandardModule: Modul1
Sub DialogAufruf()
frmNamen.Show
End Sub
ClassModule: frmNamen
Private Sub cboBis_Change()
Call FillList
End Sub
Private Sub cboVon_Change()
Dim lCounter As Long
cboBis.Clear
For lCounter = CDate(cboVon.Value) To DateSerial(2002, 1, 31)
cboBis.AddItem Format(lCounter, "dd.mm.yy")
Next lCounter
cboBis.ListIndex = 0
Call FillList
End Sub
Private Sub cmdCancel_Click()
Unload Me
End Sub
Private Sub cmdOK_Click()
Dim iCounter As Integer, iCol As Integer
Unload Me
Workbooks.Add
Range("A1").Value = "Termine vom " & cboVon.Value & " bis " & cboBis.Value
For iCounter = 0 To lstNamen.ListCount - 1
For iCol = 1 To 4
Cells(iCounter + 2, iCol) = lstNamen.List(iCounter, iCol - 1)
Next iCol
Next iCounter
ActiveSheet.PrintPreview
ActiveWorkbook.Close savechanges:=False
End Sub
Private Sub UserForm_Initialize()
Dim lCounter As Long
For lCounter = DateSerial(2002, 1, 1) To DateSerial(2002, 1, 31)
cboVon.AddItem Format(lCounter, "dd.mm.yy")
Next lCounter
cboVon.ListIndex = 0
End Sub
Private Sub FillList()
Dim arr() As Variant
Dim lCounter As Long, iCounter As Integer, iCol As Integer
If cboVon.Value = "" Or cboBis.Value = "" Then Exit Sub
lstNamen.Clear
lCounter = 1
Do Until IsEmpty(Cells(lCounter, 1))
If CDbl(Cells(lCounter, 4)) >= CDbl(CDate(cboVon.Value)) And _
CDbl(Cells(lCounter, 4)) <= CDbl(CDate(cboBis.Value)) Then
ReDim Preserve arr(0 To 3, 0 To iCounter)
For iCol = 1 To 4
arr(iCol - 1, iCounter) = Cells(lCounter, iCol)
Next iCol
iCounter = iCounter + 1
End If
lCounter = lCounter + 1
Loop
lstNamen.Column = arr
End Sub