Neuigkeiten:

Ist euer Problem gelöst, dann bitte den Knopf "Thema gelöst" drücken!

Mobiles Hauptmenü

Unterformular zeigt nicht alle Datensätze nach Filtern

Begonnen von herborizador, September 02, 2022, 10:38:53

⏪ vorheriges - nächstes ⏩

herborizador

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

markusxy

Das Problem ist für mich nicht nachvollziehbar.
Du könntest eine auf das Problem reduzierte Datenbank hochlanden.
Dann kann man sich das ansehen.



MzKlMu

Hallo
warum der Aufwand mit ungebundenen Formularen?
Gebundene Formulare lassen sich relativ einfach filtern.
Und der Code schrumpft auch um ein vielfaches.
Gruß Klaus

ebs17

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 Null
Die dreiwertige Logik von SQL
Mit freundlichem Glück Auf!

Eberhard