Hallo zusammen,
ich habe in A2013 eine Anwendung mit einem Hauptformular und darin ein Unterformular. Beide Formulare sind ungebunden. Im Hauptformulars ist eine Checkbox optMarker.
Die Checkbox liefert:
Select Case F.Controls("optMarkiert").Value
Case 0
'nur die anzeigen, die unkontrolliert sind
optMarker = 1
Case -1
'nur die markierten anzeigen
optMarker = 2
Case Else
'alles anzeigen
optMarker = 0
End Select
Beim Öffnen des Hauptformulars werden die anzuzeigenden Daten mit einer Funktion in ein temporäres ADODB-Redordset geladen. Diesee Recordset bekommt eine Sortierung und ggf. Filter auf Basis des Wertes der Checkbox optMarker - Standard ist NULL.
Beim ersten Laden werden in dem Unterformular alle 171 Datensätze angezeigt. Zudem erfolgt eine Auswertung der Inhalte der Datenquelle, in deren Folge eine Checkbox "Markiert" vorbelegt wird. In meinem Beispiel befinden sich 171 Datensätze in der Datenquelle, von denen 46 als "Markiert" vorbelegt werden. 125 sind nicht vorbelegt.
Beim erstn Start der Maske erden alle 171 Datensätze im Unterformular angezeigt.
Beim Umschalten der Checkbox optMarker zeigt das Unterformular die Daten wie folgt an:
Checkbox optMarkiert = 0 > 100 Datenstätze
Checkbox optMarkiert = -1 > 46 Datenstätze
Checkbox optMarkiert = NULL > 100 Datenstätze
Ein Kontrolle auf das Unterformular.Recordet.RecordCount ergibt immer 171 Datensätze. Es zeigt aber maximal 100 Datensätze bei Mutzung der Filterung an.
Ich stehe auf dem Schlauch und benötige Hilfe. Danke vorab.
Und hier der Code
'Code in Checkbox optMarkiert
Private Sub optMarkiert_AfterUpdate()
Debug.Print Me.optMarkiert
Select Case Me.optMarkiert
Case 0
Me.lbl_optMarkiert.Caption = "&Markierung - Ohne Häkchen anzeigen!"
Case -1
Me.lbl_optMarkiert.Caption = "&Markierung - Nur Häkchen anzeigen!"
Case Else
Me.lbl_optMarkiert.Caption = "&Markierung - Alles anzeigen!"
End Select
Call fncTLListeSortieren
End Sub
'Auszug auf Modul
Const iAnzTgl As Integer = 3
Public Function fncTLListeSortieren()
Dim i As Integer, iTgl As Integer, str1 As String
Dim sArrayString As Variant
Dim iKontroll As Integer
Dim ctl As control
Dim arySorter(iAnzTgl) As Variant
Dim UF As Form
Dim F As Form
Dim optMarker As Integer
Set F = Forms![Hauptformular]
Set UF = Forms![Hauptformular]![Unterformular].Form
'----------------------------------------------
'hier wird das OrderBY zusammengestellt:
'----------------------------------------------
iKontroll = 0
For Each ctl In UF.Controls
If ctl.ControlType = acToggleButton Then
'Debug.Print ctl.Name
If Left(ctl.Name, 3) = "tgl" Then
For i = 1 To iAnzTgl
If ctl.Name = "tgl" & i Then
If ctl.Value = True Then
iKontroll = iKontroll + 1
Select Case i
Case 1
arySorter(i) = "TNR ASC,"
Case 2
arySorter(i) = "LK ASC,"
Case 3
arySorter(i) = "TDAT,"
End Select
ElseIf ctl.Value = False Then
iKontroll = iKontroll + 1
Select Case i
Case 1
arySorter(i) = "TNR DESC,"
Case 2
arySorter(i) = "LK DESC,"
Case 3
arySorter(i) = "TDAT DESC,"
End Select
End If
End If
Next
End If
End If
Next ctl
If iKontroll > 0 Then
'Verketten Order BY
For i = 1 To iAnzTgl
sArrayString = sArrayString & arySorter(i)
Debug.Print sArrayString
Next
Else
sArrayString = ""
End If
Select Case F.Controls("optMarkiert").Value
Case 0
'nur die anzeigen, die unkontrolliert sind
optMarker = 1
Case -1
'nur die markierten anzeigen
optMarker = 2
Case Else
'alles anzeigen
optMarker = 0
End Select
If Len(sArrayString) > 0 Then
Set UF.Recordset = DatenEinlesen(True, Left(sArrayString, Len(sArrayString) - 1), optMarker)
Else
Set UF.Recordset = DatenEinlesen(True, "", optMarker)
End If
Debug.Print "UF.Recordset.RecordCount : " & UF.Recordset.RecordCount
End Function
'############
Public Function DatenEinlesen(Optional ByVal b_Quelle As Boolean = False, _
Optional ByVal sSort As String = "", _
Optional ByVal iMarker As Integer = 0) As ADODB.Recordset
Dim cnn As ADODB.Connection
Dim rstBasis As ADODB.Recordset
Dim rstTemp As ADODB.Recordset
Dim fld As ADODB.Field
Dim UF As Form
Set UF = Forms![Hauptformular]![Unterformular].Form
Set cnn = CurrentProject.Connection
If b_Quelle = False Then 'normaler erster Start
Set rstBasis = New ADODB.Recordset
Set rstTemp = New ADODB.Recordset
rstTemp.LockType = adLockOptimistic
rstTemp.CursorLocation = adUseClient
rstTemp.Fields.Append "RID", adDouble, , adFldIsNullable
rstTemp.Fields.Append "RNR", adVarWChar, 50, adFldIsNullable
rstTemp.Fields.Append "TNRINT", adDouble, , adFldIsNullable
rstTemp.Fields.Append "LDAT", adDate, , adFldIsNullable
rstTemp.Fields.Append "LK", adVarWChar, 50, adFldIsNullable
rstTemp.Fields.Append "TNR", adDouble, , adFldIsNullable
rstTemp.Fields.Append "RDat", adDate, , adFldIsNullable
rstTemp.Fields.Append "REIN", adDate, , adFldIsNullable
rstTemp.Fields.Append "RABS", adDouble, , adFldIsNullable
rstTemp.Fields.Append "N1", adVarWChar, 100, adFldIsNullable
rstTemp.Fields.Append "STR", adVarWChar, 100, adFldIsNullable
rstTemp.Fields.Append "LKZ", adVarWChar, 20, adFldIsNullable
rstTemp.Fields.Append "PLZ", adVarWChar, 20, adFldIsNullable
rstTemp.Fields.Append "Ort", adVarWChar, 100, adFldIsNullable
rstTemp.Fields.Append "RIDN", adDouble, , adFldIsNullable
rstTemp.Fields.Append "Markiert", adBoolean, False, adFldIsNullable
rstTemp.Fields.Append "TDAT", adDate, , adFldIsNullable
rstTemp.Fields.Append "FRA", adDouble, , adFldIsNullable
rstTemp.Fields.Append "MAU", adDouble, , adFldIsNullable
rstTemp.Fields.Append "DFRA", adDouble, , adFldIsNullable
rstTemp.Fields.Append "DFLO", adDouble, , adFldIsNullable
rstTemp.Fields.Append "DIES", adDouble, , adFldIsNullable
rstTemp.Fields.Append "SFAH", adDouble, , adFldIsNullable
rstTemp.Fields.Append "KZUS", adDouble, , adFldIsNullable
rstTemp.Fields.Append "SONS", adDouble, , adFldIsNullable
rstTemp.Fields.Append "STFR", adDouble, , adFldIsNullable
rstTemp.Fields.Append "KMZU", adDouble, , adFldIsNullable
rstTemp.Fields.Append "STGE", adDouble, , adFldIsNullable
rstTemp.Open
Set rstBasis = New ADODB.Recordset
rstBasis.Open "qry_CHECK_TL_Liste", cnn
Do While Not rstBasis.EOF
rstTemp.AddNew
For Each fld In rstBasis.Fields
rstTemp(fld.Name) = rstBasis(fld.Name)
Next fld
On Error Resume Next
If IsNull(rstBasis!RID) And Forms("frmRIMP").Controls("optTL").Value = False Then
'Vormarkierung für alle nicht der RID zugeordneten TNR, wenn das Häkchen in optTL leer ist
rstTemp("Markiert") = True
Else
rstTemp("Markiert") = False
End If
Err = 0
rstTemp.Update
rstBasis.MoveNext
Loop
rstTemp.Sort = "TNR"
Set DatenEinlesen = rstTemp
Else
Set rstTemp = New ADODB.Recordset
rstTemp.LockType = adLockOptimistic
rstTemp.CursorLocation = adUseClient
Set rstTemp = UF.Recordset
If sSort = "" Then
rstTemp.Sort = "TNR"
Else
rstTemp.Sort = sSort
End If
Select Case iMarker
Case 1 'nur ohne Häkchen anzeigen
rstTemp.Filter = "Markiert = 0"
Case 2 'nur mit Häkchen anzeigen
rstTemp.Filter = "Markiert = -1"
Case Else
'alles anzeigen
rstTemp.Filter = "Markiert = -1 OR Markiert = 0"
End Select
Set DatenEinlesen = rstTemp
End If
ende:
On Error Resume Next
Set rstBasis = Nothing
Set rstTemp = Nothing
Set cnn = Nothing
End Function
Das Problem ist für mich nicht nachvollziehbar.
Du könntest eine auf das Problem reduzierte Datenbank hochlanden.
Dann kann man sich das ansehen.
Hallo
warum der Aufwand mit ungebundenen Formularen?
Gebundene Formulare lassen sich relativ einfach filtern.
Und der Code schrumpft auch um ein vielfaches.
ZitatEs zeigt aber maximal 100 Datensätze bei Mutzung der Filterung an.
Mit NULL, dem Undefinierten, kann man nicht vergleichen, Datensätze mit NULL-Inhalten entfallen da automatisch.
Der Zustand NULL müsste separat abgefragt werden:
WHERE FeldX = True OR FeldX Is NullDie dreiwertige Logik von SQL (https://modern-sql.com/de/konzept/dreiwertige-logik)