Suchformular

Wie erstellt man ein Suchformular?

Zuerst einmal sollte man sich Gedanken machen, was für Felder man als Ergebnis benötigt und mit welchen Feldern diese gefiltert werden sollen.
Danach öffnet man ein leeres Formular und fügt dort all die Felder ein, die man als Filter verwenden möchte. Nun vergibt man entsprechende Namen.
Darauf werden eventuelle Abhängikeiten der Felder eingestellt und Marken vergeben. Nun erstellt man sich eine Funktion, in der man sich ein SQL-Statement
zusammenbaut, welches nachher die gefilterte Abfrage erstellt. Nun brauch man diesen String nur noch als Rowsource einem Listenfeld übergeben oder als Recordsource an ein Unterformular. Das ist alles ;-).

Also gehen wir es mal Schritt für Schritt durch.

Angenommen wir haben eine Datenbank, die Patente enthält. Nun möchten wir als Ergebnis:

Das Land

Die Patentnummer

Den Status

Den Titel

Den Anmelder

Den Erfinder

Die Kategorie

Den Zustand

Bemerkungen

Das sind also unsere Ausgabe Felder und einschränken möchten wir das durch:

Das Land

Den Anmelder

Die Kategorie

Den Zustand

Und die Stichworte zu dem Patent

Nun öffnen wir ein Formular in der Entwurfsansicht und öffnen die Toolbox, wählen ein Kombifeld aus und platzieren es im Formular.
Jetzt könnte man es mit dem Assistenten machen oder von Hand. Also wir ziehen, wenn in einer eigenen Tabelle vorhanden, die LandesID und das Landfeld in die Abfrage.
Die gebundene Spalte sollte die der LandesID sein. Das macht dann eine Datenherkunft wie diese hier:

SELECT LandesID, Land FROM tblLand

Die gebundene Spalte steht aus 1 und weil der User mit der LandesID nichts anfangen kann, stellen wie die Spaltebreite auf 0cm;2,54cm. Damit ist die 1. Spalte ausgeblendet. Nun brauchen wir nur noch eine Marke zu setzen (Reiter 'Andere').
Das Selbe wiederholen wir jetzt mit dem Anmelder, der Kategorie und dem Zustand. Nun ist es aber gut möglich, dass man mehrere Stichworte als Kriterium verwenden möchte.
Und man möchte diese vielleicht auch nicht alle oder nicht alle ganz eintippen. Also erstellen wir erstmal ein Listenfeld, wie die anderen Kombifelder. Nun gehen wir in die Eigenschaften und dort auf den Reiter
'Andere'. Hier gibt es einen Eintrag 'Mehrfachauswahl', dort wählen wir erweitert. Um dem User weiterhin die Möglichkeit zu geben Texte einzugeben, erstellen wir auch noch ein Textfeld.

Das Einzige, was wir nun noch benötigen ist ein Listenfeld oder ein Unterformular, welches die gefilterten Daten anzeigt. In der Regel verwende ich ein Listenfeld, da es einfacher zu händeln ist.
Bei diesem Listenfeld wählen wir die Datenherkunft so aus, dass die benötigten Daten dort enthalten sind. Falls Daten aus mehreren Tabellen kommen, müssen diese mit einem JOIN verbunden werden.
Da in meinem Beispiel viele Felder aus einer anderen Tabelle kommen ist der SQL-String etwas komplexer, aber sollte auch das Vorgehen verdeutlichen.

Damit haben wir schon das Formular geschafft und sogar auch einen Teil der Funktion.

Für die Funktion wechseln wir nun in den VBA-Editor. Und dort in das Klassenmodul des Formulars. Hier geben wir nun ersteinmal den Kopf unserer Funktion ein. Den Fuss erstellt Access automatisch.

Public Function FillList()

End Function

Nun holen wir aus der Datenherkunft des Ergebnislistenfeldes die benötigte SQL-Syntax und passen diese an VBA an:

Public Function FillList()
Dim strSQL As String

strSQL = "SELECT DISTINCT "
strSQL = strSQL & "tblPatent.PatentID, "
strSQL = strSQL & "tblLand.Land, "
strSQL = strSQL & "tblPatent.Patentnummer, "
strSQL = strSQL & "tblPatent.Status, "
strSQL = strSQL & "tblPatent.Titel, "
strSQL = strSQL & "tblAnmelder.Anmelder, "
strSQL = strSQL & "tblPatent.Erfinder, "
strSQL = strSQL & "tblKategorie.Kategorie, "
strSQL = strSQL & "tblZustand.Zustand, "
strSQL = strSQL & "tblPatent.Bemerkung "
strSQL = strSQL & "FROM tblStichwort INNER JOIN
strSQL = strSQL & "((tblPatentBetrifft RIGHT JOIN
strSQL = strSQL & "((tblAnmelder RIGHT JOIN "
strSQL = strSQL & "((tblKategorie RIGHT JOIN tblPatent "
strSQL = strSQL & "ON tblKategorie.KategorieID = tblPatent.KategorieID) "
strSQL = strSQL & "LEFT JOIN tblZustand ON tblPatent.ZustandID
strSQL = strSQL & "= tblZustand.ZustandsID) ON tblAnmelder.AnmelderID = "
strSQL = strSQL & "tblPatent.AnmelderID) LEFT JOIN tblLand
strSQL = strSQL & "ON tblPatent.LandID = tblLand.LandID) ON "
strSQL = strSQL & "tblPatentBetrifft.PatentID = tblPatent.PatentID)
strSQL = strSQL & "INNER JOIN tblPatentStichworte ON tblPatent.PatentID "
strSQL = strSQL & "= tblPatentStichworte.PatentID)
strSQL = strSQL & "ON tblStichwort.StichwortID = "
strSQL = strSQL & "tblPatentStichworte.StichwortID "
End Function

Soweit so gut. Um nun die Steuerelemente auf dem Formular zu durchlaufen benötigen wir noch eine Steuerelementvariable. Und um die einzelnen Teile des SQL-String auch getrennt händeln zu können 2 weitere Stringvariablen.
Um das Listenfeld durchlaufen zu können, brauchen wir eine Variantvariable und für das Textfeld ebenfalls. Das macht dann folgende Variablen:

Public Function FillList()
Dim var                         As Variant 'Für das Listenfeld
Dim varArray                    As Variant 'Für das Textfeld
Dim strSQL, sStich, sSQL        As String  'Für die einzelnen SQL-Segmente
Dim ctl                         As Control 'Für die Steuerelemente
Dim i                           As Long    'Für For...Next-Schleifen

strSQL = "SELECT DISTINCT "
strSQL = strSQL & "tblPatent.PatentID, "
strSQL = strSQL & "tblLand.Land, "
strSQL = strSQL & "tblPatent.Patentnummer, "
strSQL = strSQL & "tblPatent.Status, "
strSQL = strSQL & "tblPatent.Titel, "
strSQL = strSQL & "tblAnmelder.Anmelder, "
strSQL = strSQL & "tblPatent.Erfinder, "
strSQL = strSQL & "tblKategorie.Kategorie, "
strSQL = strSQL & "tblZustand.Zustand, "
strSQL = strSQL & "tblPatent.Bemerkung "
strSQL = strSQL & "FROM tblStichwort INNER JOIN
strSQL = strSQL & "((tblPatentBetrifft RIGHT JOIN
strSQL = strSQL & "((tblAnmelder RIGHT JOIN "
strSQL = strSQL & "((tblKategorie RIGHT JOIN tblPatent "
strSQL = strSQL & "ON tblKategorie.KategorieID = tblPatent.KategorieID) "
strSQL = strSQL & "LEFT JOIN tblZustand ON tblPatent.ZustandID
strSQL = strSQL & "= tblZustand.ZustandsID) ON tblAnmelder.AnmelderID = "
strSQL = strSQL & "tblPatent.AnmelderID) LEFT JOIN tblLand
strSQL = strSQL & "ON tblPatent.LandID = tblLand.LandID) ON "
strSQL = strSQL & "tblPatentBetrifft.PatentID = tblPatent.PatentID)
strSQL = strSQL & "INNER JOIN tblPatentStichworte ON tblPatent.PatentID "
strSQL = strSQL & "= tblPatentStichworte.PatentID)
strSQL = strSQL & "ON tblStichwort.StichwortID = "
strSQL = strSQL & "tblPatentStichworte.StichwortID "
End Function

Nun machen wir uns an die Auswertung des Listenfeldes:

'//Listenfeld auswerten

'ItemsSelected.Count zählt wieviele Einträge im Listenfeld markiert sind
If Me!lstStichwort.ItemsSelected.Count > 0 Then

	'Für jeden markierten Eintrag im Listenfeld
    For Each var In Me!lstStichwort.ItemsSelected
    
        'Übergib der Variablen eine Oder-Verknüpfung und suche in den Feldern nach den Einträgen des Listenfeldes
        sStich = sStich & " OR tblPatentStichworte.StichwortID = " & Me!lstStichwort.ItemData(var)
        
    Next var
    
End If

Auswertung des Textfeldes:

'//Textfeld zerlegen und als Kriterium übergeben

'Wenn dort überhaupt etwas steht
If Len(Nz(Me!txtStichwort, "")) <> 0 Then

	'Split steht erst ab Access 2000 zur Verfügung, in der DBWiki gibt es aber einen Ersatz
	'Zerlege den Text nach jedem "," und schreibe den Wert in ein Array
    varArray = Split(Me!txtStichwort, ",")
    
    'Durchlaufe das Array LBound ist der kleinste Index und UBound der Größte
    For i = LBound(varArray) To UBound(varArray)
    
        'Das Gleiche wie beim Listenfeld
        sStich = sStich & " OR tblStichwort.Stichwort = '" & varArray(i) & "'"
        
    Next i
    
End If

Auswertung der anderen Steuerelemente. ctl enthält den Wert und mit ctl.Eigenschaft kann man eine Eigenschaft auswerten:

'//Alle anderen Felder auswerten

'Für jedes Steuerelement in der Steuerelementauflistung
For Each ctl In Me.Controls

	'Wenn die Marke vorhanden ist
    If Left(ctl.Tag, 1) = "x" Then
    
        'Wenn etwas anderes als Alle ausgewählt wurde
        If ctl > 0 Then
            'Sonderbehandlung für dieses Feld,
			' weil es eine andere Tabelle betrifft
            If ctl.Name = "cmbBetroffen" Then
            
                sSQL = sSQL & " AND tblPatentBetrifft.BetroffenStatus = " & ctl
                
            Else
            
                sSQL = sSQL & " AND tblPatent." & Mid(ctl.Name, 4) & " = " & ctl
                
            End If
        End If
    End If
Next ctl

Nun fehlt nur noch die Verkettung der einzelnen SQL-Segmente und die Übergabe an das Listenfeld:

'//SQL-String zusammensetzen

'Wenn sSQL einen Wert hat
If Len(Nz(sSQL, "")) <> 0 Then
    strSQL = strSQL & " WHERE " & Mid(sSQL, 5)
End If

'Wenn sStich einen Wert hat
If Len(Nz(sStich, "")) <> 0 Then
	'Wenn schon ein WHERE vorhanden ist
    If InStr(1, strSQL, "WHERE", vbTextCompare) > 0 Then
        strSQL = strSQL & sStich
    Else
        strSQL = strSQL & " WHERE " & Mid(sStich, 4)
    End If
End If

'Übergabe an das Listenfeld
Me!lstPatente.RowSource = strSQL

Und hier das Endergebnis:

Private Function ListFill()
Dim var                         As Variant 'Für das Listenfeld
Dim varArray                    As Variant 'Für das Textfeld
Dim strSQL, sStich, sSQL        As String  'Für die einzelnen SQL-Segmente
Dim ctl                         As Control 'Für die Steuerelemente
Dim i                           As Long    'Für For...Next-Schleifen

strSQL = "SELECT DISTINCT "
strSQL = strSQL & "tblPatent.PatentID, "
strSQL = strSQL & "tblLand.Land, "
strSQL = strSQL & "tblPatent.Patentnummer, "
strSQL = strSQL & "tblPatent.Status, "
strSQL = strSQL & "tblPatent.Titel, "
strSQL = strSQL & "tblAnmelder.Anmelder, "
strSQL = strSQL & "tblPatent.Erfinder, "
strSQL = strSQL & "tblKategorie.Kategorie, "
strSQL = strSQL & "tblZustand.Zustand, "
strSQL = strSQL & "tblPatent.Bemerkung "
strSQL = strSQL & "FROM tblStichwort INNER JOIN
strSQL = strSQL & "((tblPatentBetrifft RIGHT JOIN
strSQL = strSQL & "((tblAnmelder RIGHT JOIN "
strSQL = strSQL & "((tblKategorie RIGHT JOIN tblPatent "
strSQL = strSQL & "ON tblKategorie.KategorieID = tblPatent.KategorieID) "
strSQL = strSQL & "LEFT JOIN tblZustand ON tblPatent.ZustandID
strSQL = strSQL & "= tblZustand.ZustandsID) ON tblAnmelder.AnmelderID = "
strSQL = strSQL & "tblPatent.AnmelderID) LEFT JOIN tblLand
strSQL = strSQL & "ON tblPatent.LandID = tblLand.LandID) ON "
strSQL = strSQL & "tblPatentBetrifft.PatentID = tblPatent.PatentID)
strSQL = strSQL & "INNER JOIN tblPatentStichworte ON tblPatent.PatentID "
strSQL = strSQL & "= tblPatentStichworte.PatentID)
strSQL = strSQL & "ON tblStichwort.StichwortID = "
strSQL = strSQL & "tblPatentStichworte.StichwortID "


'//Listenfeld auswerten
If Me!lstStichwort.ItemsSelected.Count > 0 Then
    For Each var In Me!lstStichwort.ItemsSelected
        sStich = sStich & " OR tblPatentStichworte.StichwortID = " _
				& Me!lstStichwort.ItemData(var)
    Next var
End If

'//Textfeld zerlegen und als Kriterium übergeben
If Len(Nz(Me!txtStichwort, "")) <> 0 Then
    varArray = Split(Me!txtStichwort, ",")
    For i = LBound(varArray) To UBound(varArray)
        sStich = sStich & " OR tblStichwort.Stichwort = '" & varArray(i) & "'"
    Next i
End If

'//Alle anderen Felder auswerten
For Each ctl In Me.Controls
    If Left(ctl.Tag, 1) = "x" Then
        If ctl > 0 Then
            If ctl.Name = "cmbBetroffen" Then
                sSQL = sSQL & " AND tblPatentBetrifft.BetroffenStatus = " & ctl
            Else
                sSQL = sSQL & " AND tblPatent." & Mid(ctl.Name, 4) & " = " & ctl
            End If
        End If
    End If
Next ctl

'//SQL-String zusammensetzen
If Len(Nz(sSQL, "")) <> 0 Then
    strSQL = strSQL & " WHERE " & Mid(sSQL, 5)
End If

If Len(Nz(sStich, "")) <> 0 Then
    If InStr(1, strSQL, "WHERE", vbTextCompare) > 0 Then
        strSQL = strSQL & sStich
    Else
        strSQL = strSQL & " WHERE " & Mid(sStich, 4)
    End If
End If
Me!lstPatente.RowSource = strSQL
End Function

Nun fehlt nur noch, dass man nach Aktualisierung jeden Feldes diese Funktion aufruft:

Private Sub Feld_AfterUpdate()
FillList
End Sub

Und wenn ihr das mal in Aktion sehen wollt, dann könnt ihr es euch hier runterladen. Es ist allerdings in Access 2000! Wenn ihr es in Access 97 haben wollt, dann benutzt doch einfach das Kontaktformular.

Navigation

Access

Site Counter