Flexiblere Listen

15.08.2006 von Lorenz  Hölscher
Comboboxen und Listboxen können beliebig viele Datensätze anzeigen, wenn sie aus Tabellen oder Abfragen kommen, nicht jedoch, wenn sie aus anderen Datenquellen stammen. Sie hatten damit noch nie Probleme? Glück gehabt, denn diese Listen sind je nach Datenquelle begrenzt. Aber wie Sie sehen werden, können Sie dem Glück mit Callback-Funktionen auf die Sprünge helfen.

Das klassische Problem der Datenmenge stellt sich schon bei der Anzeige von Dateinamen eines Verzeichnisses. Da die Inhalte nicht erst mühsam in eine Tabelle geschrieben werden sollen, werden alle Angaben mit Semikolon getrennt in die Datensatzherkunft geschrieben.

Listing 1 zeigt die grundsätzliche Technik für das in Bild 1 dargestellte Testformular.

Option Compare Database
Option Explicit
Dim datStart As Date
Dim datEnde As Date
Const Pfad1 = "c:\Windows\System\"
Const Pfad2 = "c:\Windows\System32\"
Private Sub Form_Load()
cmbPfad.RowSource = Pfad1 & ";" & Pfad2
cmbPfad.Value = Pfad1
End Sub
Private Sub btnRowSource_Click()
Dim aktDatei As String
On Error GoTo Mist
DoCmd.Hourglass True
datStart = Now()
With lstDateien
.RowSourceType = "Value list"
.RowSource = ""
aktDatei = Dir(cmbPfad.Value & "*.*")
Do While aktDatei <> ""
With lstDateien
.RowSource = .RowSource & aktDatei & ";" & _
FileDateTime(cmbPfad.Value & aktDatei) & ";" & _
FileLen(cmbPfad.Value & aktDatei) & ";"
End With
aktDatei = Dir()
Loop
End With
Mist:
datEnde = Now()
EndeMeldung
If Err.Number <> 0 Then
MsgBox "Abgebrochen, denn: " & Err.Description, vbCritical
End If
End Sub
Private Sub EndeMeldung()
lblDauer.Caption = "Dauer: " & _
Format(datEnde - datStart, "hh:mm:ss")
lblDateien.Caption = lstDateien.ListCount & _
" Dateien in " & Me.cmbPfad.Value
lblLang.Caption = Len(lstDateien.RowSource) & " Zeichen"
DoCmd.Hourglass False
End Sub
Static datStartTag As Date
Dim datNaechsteWoche As Date
Select Case Code
Case acLBInitialize
datStartTag = Date + 7 - _
Weekday(Date, vbMonday) - 1 + _
Me.cmbWerktage.Value
FolgeWerktage = True
Case acLBOpen
FolgeWerktage = Timer
Case acLBGetRowCount
FolgeWerktage = 10
Case acLBGetColumnCount
FolgeWerktage = 1
Case acLBGetColumnWidth
FolgeWerktage = -1
Case acLBGetValue
datNaechsteWoche = datStartTag + Zeile * 7
FolgeWerktage = Format(datNaechsteWoche, _
"DDDD"", der ""DD. MMMM YYYY")
End Select
End Function

Bild 1: Formular zur Anzeige von Dateien.

Beim Laden des Formulars wird eine Combobox cmbPfad mit dem Herkunftstyp Wertliste ganz einfach mit zwei typischen Systemverzeichnissen vorbelegt.

Explorer-ähnliche Darstellung

In btnRowSource_Click kann dann aus dem gewählten Pfad mit der Dir()-Funktion die jeweils nächste Datei ermittelt und an die bisherigen Inhalte der Datensatzherkunft (RowSource) angehängt werden. Die Listbox lstDateien wurde im Entwurf dazu auf Herkunftstyp Wertliste gestellt und zeigt Inhalte der Form "Datei1;Datei2; Datei3" dann zeilenweise an.

Zusätzlich sollen wie im Explorer das Dateidatum und die Länge angezeigt werden, sodass der Inhalt der Datensatzherkunft tatsächlich "Datei1;Datum1;Länge1;Datei2;Datum2;..." ist.

Um Geschwindigkeitsunterschiede zu finden, werden mit den globalen Variablen datStart und datEnde Zeitmessungen vorgenommen und in der Prozedur EndeMeldung angezeigt. Sie werden aber feststellen, dass die Zeit nicht das eigentliche Problem ist.

Begrenzte Datenmenge

Für wenige Dateien klappt das alles wunderbar. Aber in großen Verzeichnissen wie \Windows\ System32 mit rund 2.500 Dateien scheitert diese Technik an der Länge der entstehenden Zeichenkette.

In Access 97 darf die Länge der Datensatzherkunft nur maximal 2.048 Zeichen, ab Access 2000 wenigstens rund 32.000 Zeichen betragen. Das sind mit Name, Datum und Länge selbst in günstigen Fällen kaum 70 beziehungsweise 1.000Dateien.

Das mag viel erscheinen, aber Sie können vorher nie wissen, ob Ihr Benutzer das Verzeichnis nicht überfüllt hat. Dann wäre eine Fehlermeldung wie „Die Einstellung dieser Eigenschaft ist zu lang“ wenig hilfreich.

Zeilen anders hinzufügen

Wenig bekannt und unter Access kaum üblich ist eine weitere Technik, Zeilen an eine Listbox oder Combobox anzufügen: mit AddItem. Listing 2 zeigt die minimalen Änderungen gegenüber dem vorigen Code. Da bei den anderen Office-Programmen in diesem Fall neue Elemente zu einem internen Array hinzugefügt werden, gäbe es hier die Hoffnung, dass die Grenze für die Zeichenkette damit uninteressant wird.

Private Sub btnAddItem_Click()
'wie bei btnRowSource_Click
Do While aktDatei <> ""
With lstDateien
.AddItem aktDatei & ";" & _
FileDateTime(cmbPfad.Value & aktDatei) & ";" & _
FileLen(cmbPfad.Value & aktDatei) & ";"
End With
aktDatei = Dir()
Loop
'wie bei btnRowSource_Click
End Sub

Das hilft aber leider nicht. Access-Controls unterscheiden sich nämlich von denjenigen aus Word oder Excel. Auch AddItem führt zur gleichen Fehlermeldung, also wird intern nur die Datensatzherkunft-Zeichenkette befüllt

Callback-Funktion aufrufen

Genau für dieses Problem ist die Callback-Technik gedacht: Der VBA-Code legt seine Daten in beliebig großen Arrays ab, und die Combobox oder Listbox lädt per Funktion nur den sichtbaren Ausschnitt nach.'

Diese Technik heißt „Callback“, wobei das Control selber nur den Namen einer Funktion genannt bekommt. Diese kann es dann nach eigener Entscheidung mit wechselnden Parametern aufrufen. Sie benötigen keine Ereignisse zum aktiven Aufruf der Funktion, vielmehr muss die Funktion auf den Rückruf (Callback) der Liste warten.

Es ist nur schade, dass es in Access keinerlei Hinweis auf diese Technik gibt. In der Eigenschaft Herkunftstyp hätte beispielsweise in der Auswahl eine zusätzliche Zeile Callback-Funktion stehen können.

Mehr ist nämlich davon nicht zu sehen: In Herkunftstyp steht der Name einer beliebigen Funktion ohne Klammern oder Gleichheitszeichen. Daher ist der Aufruf wie in Listing 3 sehr kurz.

Private Sub btnCallback_Click()
DoCmd.Hourglass True
datStart = Now()
With lstDateien
.RowSourceType = "HoleDateien"
.RowSource = ""
End With
datEnde = Now()
EndeMeldung
End Sub

Wenn nicht wie hier zu Testzwecken die Eigenschaften der Listbox laufend geändert werden, können Sie den Namen selbstverständlich auch direkt im Entwurf in den Herkunftstyp schreiben.

Callback-Funktion schreiben

Jetzt fehlt nur noch das Gegenstück, nämlich die Funktion selber. Ihr Name ist beliebig, aber die Parameter sind in Reihenfolge und Typ festgelegt, wie in Listing 4 zu sehen ist. Die Namen der Parameter finden sich in Beispielen häufig auch in englischer Sprache, können aber auch frei gewählt werden.

Function Demo(Feld As Control, ID As Variant, _
Zeile As Variant, Spalte As Variant, Code As Variant) As Variant
Select Case Code
Case acLBInitialize
Demo = {True|False}
Case acLBOpen
Demo = eindeutigeID
Case acLBGetRowCount
Demo = {AnzahlZeilen|-1}
Case acLBGetColumnCount
Demo = AnzahlSpalten
Case acLBGetColumnWidth
Demo = SpaltenBreiten
Case acLBGetValue
Demo = Wert
Case acLBEnd
aufräumen, wenn nötig
End Select
End Function

Die Funktion selber wird bei der Aktualisierung einer Liste von dieser mit verschiedenen Code-Konstanten aufgerufen. Dadurch „weiß“ die Funktion, welche Ergebnisse gerade gebraucht werden. Beim ersten Aufruf mit acLBInitialize ist es sinnvoll, alle Daten zu ermitteln und in einem Array bereitzuhalten. Achtung: Variablen wie ein solches Array müssen als Static deklariert werden, damit sie beim nächsten Aufruf nicht leer sind!

Listing 5 zeigt den konkreten Code für die Anzeige aller Dateien eines Verzeichnisses. Die Funktion befindet sich wie alle anderen Prozeduren im Formularmodul und kann deswegen auch direkt auf die Inhalte anderer Controls wie cmbPfad zugreifen.

Function HoleDateien(Feld As Control, ID As Variant, _
Zeile As Variant, Spalte As Variant, Code As Variant) As Variant
Static Dateien() As String
Dim aktDatei As String
Static L As Long
HoleDateien = Null
Select Case Code
Case acLBInitialize
L = 0
ReDim Dateien(2, 0)
aktDatei = Dir(cmbPfad.Value & "*.*")
Do While aktDatei <> ""
Dateien(0, L) = aktDatei
Dateien(1, L) = FileDateTime(cmbPfad.Value & aktDatei)
Dateien(2, L) = FileLen(cmbPfad.Value & aktDatei)
ReDim Preserve Dateien(2, UBound(Dateien, 2) + 1)
L = L + 1
aktDatei = Dir()
Loop
ReDim Preserve Dateien(2, UBound(Dateien, 2) - 1)
HoleDateien = L
Case acLBOpen
HoleDateien = Timer
Case acLBGetRowCount
HoleDateien = L - 1
Case acLBGetColumnCount
HoleDateien = 3
Case acLBGetColumnWidth
HoleDateien = -1
Case acLBGetValue
HoleDateien = Dateien(Spalte, Zeile)
Case acLBEnd
Erase Dateien
End Select
End Function

Nach dem Loop über alle Dateien muss das Array Dateien noch in der zweiten Dimension um einen Eintrag gekürzt werden, damit keine Leerzeile übrig bleibt.

Mit Redim Preserve können Arrays vergrößert und verkleinert werden, ohne dass ihr Inhalt verloren geht. Allerdings ist das nur für die letzte Dimension zulässig.

Rückgabewerte

Eigentlich sollte für acLBInitialize der Rückgabewert der Funktion True oder False sein. False wäre sinnvoll, wenn etwa ein Zugriff auf das Verzeichnis gescheitert ist, so dass jeder weitere Aufruf direkt unterbleibt.

Praktischerweise entspricht aber False dem Wert 0, und für True wird jede andere Zahl akzeptiert. Deswegen können Sie hier einfach die Anzahl der Dateien übergeben. Solange mehr als 0Dateien gefunden wurden, wird die Antwort als True interpretiert. In allen anderen Fällen übergibt die Funktion als Rückgabewert direkt die gewünschten Werte.

Der Timer-Wert in acLBOpen ist lediglich die einfachste Methode, eine eindeutige Zahl zu ermitteln. Beim nächsten Aufruf können Sie dann den Aufrufer an der mit übergebenen ID erkennen. Das ist nur wichtig, wenn verschiedeneControls diese Funktion gleichzeitig aufrufen, beispielsweise mehrere Listenfelder parallel mit unterschiedlichen Verzeichnissen.

In acLBGetRowCount und acLBGetColumn- Count wird die Anzahl der Zeilen und Spalten ermittelt. Falls die Zeilenzahl unbekannt ist, können Sie dort auch -1 angeben.

Die Spaltenbreiten in acLBGetColumnWidth müssen bei Bedarf verschiedene Werte je nach dem Wert von Spalte zurückgeben. Sie können dies in Listing 7 beispielhaft sehen.

Function AusRS(fld As Control, ID As Variant, Zeile As Variant, _
Spalte As Variant, Code As Variant) As Variant
Static arrInhalt() As Variant
Static L As Long
On Error GoTo Mist
Select Case Code
Case acLBInitialize
ReDim arrInhalt(RS.RecordCount - 1, 2)
L = 0
RS.MoveFirst
Do Until RS.EOF
arrInhalt(L, 0) = RS.Fields("NID").Value & vbNullString
arrInhalt(L, 1) = RS.Fields("NText").Value & vbNullString
arrInhalt(L, 2) = RS.Fields("NCode").Value & vbNullString
L = L + 1
RS.MoveNext
Loop
AusRS = (L > 0)
Case acLBOpen
AusRS = Timer
Case acLBGetRowCount
AusRS = L
Case acLBGetColumnCount
AusRS = 3
Case acLBGetColumnWidth
Select Case Spalte
Case 0:
AusRS = 0.5 * conTWIPS
Case 1:
AusRS = 3 * conTWIPS
Case 1:
AusRS = 0.5 * conTWIPS
End Select
Case acLBGetValue
AusRS = arrInhalt(Zeile, Spalte)
End Select
Exit Function
Mist:
MsgBox "Fehler Nr. " & Err.Number & _
" in Callback-Funktion: " & Err.Description, vbCritical
End Function
Bild 2: Datensätze mit Zwischenüberschriften.
2006_08_Access.qxp 20.06.2006 11:00 Seite 2010

Arraywerte ermitteln

Die wesentliche Arbeit der Funktion besteht aber darin, die Arraydaten für die Zeilen zu liefern. Daher wird acLBGetValue mit Abstand am häufigsten aufgerufen. Anhand der ebenfalls übergebenen Angaben für Zeile und Spalte können Sie die entsprechenden Inhalte Ihres Arrays liefern. Dabei wird nie das ganze Array, sondern immer nur der sichtbare Teil der Combobox oder Listbox abgefragt. Leider geschieht das aber mit jeder nötigen Aktualisierung erneut.

Sie sehen das, wenn Sie in einer Listbox den Rollbalken benutzen oder sogar beim Wechsel von einem anderen Programm wieder zurück zu Access. Jedes Mal werden die Daten ersichtlich neu gelesen und in die Liste geschrieben.

Unbegrenzte Leistungsfähigkeit

Diese Fähigkeit zur Aufforderung an die Funktion, nur jeweils einen Teil der Datenmenge zu liefern, ist auch der Trick, warum nun eine unbegrenzte Datenfülle verarbeitet werden kann. Damit ist durchaus auch eine Tabelle oder Abfrage als Datenquelle wieder interessant. Gegenüber den „nur“ etwa 2.500 Dateien in \System32 können da schnell einige zigtausend Datensätze zusammenkommen.

Die Click-Prozeduren gleichen denen aus Listing 3, da sich nur der Name der Callback-Funktion ändert, wie Sie in Listing 6 sehen.

Option Compare Database
Option Explicit
Dim datStart As Date
Dim datEnde As Date
Dim RS As RecordSet
Const conTWIPS = 1440
'Private Sub btn..._Click()
' wie in Listing 3, aber:
' .RowSourceType = "ausRS"
' bzw.
' .RowSourceType = "ausRSPlus"
Private Sub btnRS_Click()
Set RS = CurrentDb.OpenRecordset("qryNamen", dbOpenSnapshot)
RS.MoveLast
btnCallback.Enabled = True
btnCallbackPlus.Enabled = True
End Sub
Private Sub btnSQL_Click()
DoCmd.Hourglass True
datStart = Now()
With lstDaten
.RowSourceType = "Table/Query"
.RowSource = "qryNamen"
End With
datEnde = Now()
EndeMeldung
End Sub

Das Recordset RS, also die Daten der Tabelle oder Abfrage, ist eine globale Variable und wird mit einem eigenen Button geöffnet. Dadurch bleibt das eher langwierige Öffnen in der Zeitmessung unberücksichtigt.

Mit btnRS_Click wird zum Vergleich die herkömmliche Zuweisung eines Recordsets direkt an die Listbox ausgeführt.

Datensätze auslesen

Der wesentliche Unterschied zu Listing 5 besteht in Listing 7 darin, dass diesmal in acLBInitialize statt eines Verzeichnisses ein Recordset in ein Array kopiert wird.

In acLBGetColumnWidth sehen Sie die Angabe unterschiedlicher Spaltenbreite mittels einer geschachtelten Select-Case-Konstruktion.

Fehler in der Callback-Funktion finden

Grundsätzlich ist es empfehlenswert, in der Callback- Funktion wenigstens während der Entwicklungszeit eine Fehlerbehandlung einzubauen. Falls nämlich ein Laufzeitfehler auftritt oder versehentlich ein ungültiger Wert zurückgegeben wird, beendet Access den Aufruf der Funktion ohne weitere Meldung.

Breakpoints, die Sie ja in einer VBA-Zeile mit [F9] setzen können, sind höchstens bei acLBInitialize machbar. Bei acLBGetValue hingegen finden für 20 Zeilen in 3 Spalten ja 60 Aufrufe der Funktion statt. Nur die eigens erzeugte Fehlermeldung bietet dann eine Chance, das Problem zu finden.

Datenwerte anreichern

Beim Vergleich dieser Callback-Funktion ausRS mit btnSQL_Click werden Sie allerdings feststellen, dass die herkömmliche Zuweisung mit dem Herkunftstyp Tabelle/Abfrage um ein Vielfaches schneller ist. Es gibt zwar Konstellationen mit Oracle statt Access als Datenquelle, wo eine Callback- Funktion merklich schneller ist als die direkte Zuweisung. Aber als einfache Anzeige für Daten empfiehlt sich die Technik erst einmal nicht.

Wenn Sie jedoch Zusatzinformationen zwischen den Datensätzen einfügen wollen, sieht das ganz anders aus. Ein einfaches Beispiel sollen hierfür Zwischenüberschriften sein, wenn ein neuer Anfangsbuchstabe kommt.

Die entsprechende Callback-Funktion ausRSPlus unterscheidet sich von ausRS nur in den Zeilen, die in Listing 8 fett markiert sind. In der String-Variablen strVorher steht immer der bisher gültige Anfangsbuchstabe. Sobald die aktuelle Datenzeile mit einem anderen Buchstaben beginnt, wird das Array arrInhalt vergrößert und eine Überschrift-Zeile hinzugefügt.

Static arrInhalt() As Variant
Static strVorher As String
Static strJetzt As String
Static L As Long
' wie in Listing 7
Case acLBInitialize
ReDim arrInhalt(2, RS.RecordCount - 1)
L = 0
strVorher = ""
RS.MoveFirst
Do Until RS.EOF
strJetzt = Left(RS.Fields("NText").Value & vbNullString, 1)
If LCase(strVorher) <> LCase(strJetzt) Then
ReDim Preserve arrInhalt(2, UBound(arrInhalt, 2) + 1)
arrInhalt(0, L) = ""
arrInhalt(1, L) = "[" & UCase(strJetzt) & _
"] " & String(50, "_")
arrInhalt(2, L) = String(50, "_")
L = L + 1
strVorher = strJetzt
End If
arrInhalt(0, L) = RS.Fields("NID").Value & vbNullString
arrInhalt(1, L) = RS.Fields("NText").Value & vbNullString
arrInhalt(2, L) = RS.Fields("NCode").Value & vbNullString
L = L + 1
RS.MoveNext
Loop
' wie in Listing 7

Bild 2: Datensätze mit Zwischenüberschriften.

Das Ergebnis sieht aus wie in Bild 2 und setzt natürlich voraus, dass die benutzte Abfrage qryNamen bereits nach dem Feld NName sortiert ist.

Fiktive Daten anzeigen

Natürlich lässt sich diese Technik erweitern, indem Sie nicht nur zwischen physikalisch vorhandene Daten eigene einfügen, sondern nur noch fiktive Werte anzeigen. Schließlich kann entweder das Array direkt beliebige Werte enthalten, oder die Funktion berechnet diese erst beim Aufruf in acLBGetValue.

Bild 3: Auswahl beliebiger zukünftiger Werktage.

In Bild 3 sehen Sie ein Formular zur Auswahl der nächstfolgenden Werktage, beispielsweise für einen Wiedervorlage-Termin. Je nach Auswahl eines Werktags in cmbWerktage werden die nächsten 10 passenden Datumswerte angezeigt. Da wäre es wenig sinnvoll, in einer Tabelle einen Vorrat an Datumswerten zu sammeln. Vielmehr wird mittels einer Berechnung vom aktuellen Tag ausgehend zehnmal ein Datum errechnet (Listing 9).

Option Compare Database
Option Explicit
Private Sub cmbWerktage_Click()
Me.lstCallback.Requery
End Sub
Private Sub Form_Open(Cancel As Integer)
With cmbWerktage
.RowSource = vbMonday & ";Montag;" & _
vbTuesday & ";Dienstag;" & _
vbWednesday & ";Mittwoch;" & _
vbThursday & ";Donnerstag;" & _
vbFriday & ";Freitag;" & _
vbSaturday & ";Samstag;" & _
vbSunday & ";Sonntag"
.Value = 1
End With
Me.lstCallback.RowSourceType = "FolgeWerktage"
End Sub
Function FolgeWerktage(Feld As Control, ID As Variant, _
Zeile As Variant, Spalte As Variant, Code As Variant) As Variant

Der rechnerische Trick basiert auf der FunktionWeekday, welche die Wochentage mit Zahlen kennzeichnet. Die gleichen Zahlen werden in cmbWerktage als gebundene, erste Spalte gespeichert. Daher darf die Zuweisung von Folge- Werktage an lstCallback als Callback-Funktion erst erfolgen, nachdem cmbWerktage mit Daten gefüllt ist, wie Sie in Form_Load sehen.

Damit es schneller geht, wird der jeweils erste Datumswert mit dem gewünschten Werktag nur einmal als datStartTag in acLBInitialize errechnet.

In acLBGetValue müssen Sie dann zu diesem Startwerktag nur noch das Siebenfache der aktuellen Zeile addieren, um den jeweils gleichen Werktag der nächsten Woche(n) zu finden. Die Menge der gewünschten Daten geben Sie als festen Rückgabewert in acLBGetRowCount vor.

Wie Sie sehen, können Sie mit der Callback- Technik die manchmal sehr engen Grenzen von Comboboxen und Listboxen um interessante Funktionalitäten erweitern.