Microsoft Excel

Excel und VBA: Formeln, Programmierung, Lösungen

Die Excel/VBA-Beispiele

Thema

UserForm-ListBox in Abhängigkeit von Datumsauswahl füllen

Gruppe

ListBox

Problem

Über eine UserForm sollen Start- und Enddatum festgelegt und die passenden Daten in eine mehrspaltige ListBox eingelesen werden.

Lösung
Geben Sie den nachstehenden Code in das Klassenmodul der UserForm ein.

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