Vba code filter rapport werkt niet

Status
Niet open voor verdere reacties.

Dencar77

Gebruiker
Lid geworden
15 mrt 2013
Berichten
131
Beste lezers,

ik heb in ms Access een zoekformulier gemaakt. Hierin kan ik op 3 velden zoeken, namelijk een PLAATS (volledige naam) en JOURNAAL (maak gebruik van Like) en een datumgroep. Daarnaast heb ik 2 knoppen gemaakt, een FILTER knop en een RESET FILTER knop.
Op het formulier zie ik (bron is een query) netjes de juiste resultaten.

Nu wil ik graag ook gebruik maken van een rapport. Dit rapport moet de gegevens die ik gefilterd had, tonen. Nu zie ik constant op het rapport ALLE records in plaats van de filtering.

Kan iemand mij aangeven wat ik fout doe? Ik heb vermoedelijk niet de juiste printcode aangemaakt. (cmdPrintZkJournaal)

Code:
'Doel:      Met dit formulier toon ik aan hoe je een zoekformulier maakt, _
            ongeacht of men veel of weinig velden invult, _
            de resultaten worden per regel getoond.
'Noot:      Alleen de records ALL van de criteria worden getoond.
'Auteur:    DenCar, Oktober 2013 | Allen Browne, Juni 2006.
Option Compare Database
Option Explicit

Private Sub cmdFilter_Click()
    'Doel:         Maak de criteria string formulier met lege zoekvelden, en laat deze reageren op de fomulierfilter.
    'Notities:     1. Ik label " AND " aan het einde van elke "condition" om daarmee sneller nieuwe zoekvelden toe te kunnen voegen; _
                        ik verwijder de " AND " op het einde.
    '              2. De datum notaties werkt als volgt: _
                        Beide datums      = alleen tussenliggende datums (inclusief beiden. _
                        Startdatum alleen = alle datums vanaf deze en verder; _
                        Einddatum alleen  = all datums tot aan(inclusief deze).
    Dim strRapport As String                'Rapport criteria.
    Dim strWhere As String                  'De criteria string.
    Dim lngLen As Long                      'Lengte van de criteria string.
    Const conJetDate = "\#mm\/dd\/yyyy\#"   'De format verwacht de datums in een JET query string.
    
    strRapport = "RapportZkJournaal"        'Plaats tussen de haakjes je rapportnaam
    '***********************************************************************
    'Kijk naar elk zoekveld, and creeer de criteria string van de lege zoekvelden.
    '***********************************************************************
    'Tekstveld voorbeeld. Gebruik quotes rondom de waarde van de string.
    If Not IsNull(Me.TxtPlaats) Then
        strWhere = strWhere & "([PLAATS] = """ & Me.TxtPlaats & """) AND "
    End If
    
    'Nog een tekstveld voorbeeld. Gebruik Like om willekeurig te zoeken in het veld.
    If Not IsNull(Me.TxtJournaal) Then
        strWhere = strWhere & "([Journaal] Like ""*" & Me.TxtJournaal & "*"") AND "
    End If
    
    'Datumveld voorbeeld. Gebruik de format string om het #-teken toe te voegen en verkrijg de juiste internationale format.
    If Not IsNull(Me.TxtStartdatum) Then
        strWhere = strWhere & "([datum] >= " & Format(Me.TxtStartdatum, conJetDate) & ") AND "
    End If
    
    'Nog een Datumveld voorbeeld. Gebruik  "less than the next day" omdat dit veld buiten datum ook de tijd weergeeft.
    If Not IsNull(Me.TxtEinddatum) Then   'Less than the next day.
        strWhere = strWhere & "([datum] < " & Format(Me.TxtEinddatum + 1, conJetDate) & ") AND "
    End If
    
    '***********************************************************************
    'beeindig het " AND ", en gebruik de string als formuliers Filter.
    '***********************************************************************
    'Controleert of de string meer dan 5 karakters heeft (a trailing " AND ") om te laten verwijderen.
    lngLen = Len(strWhere) - 5
    If lngLen <= 0 Then     'Er was niets in de string.
        MsgBox "Er is niets ingevoerd", vbInformation, "Geen invoer."
    Else                    'Er is iets in de string, dus verwijder de " AND " op het einde.
        strWhere = Left$(strWhere, lngLen)
        'Voor Foutopsporing(debugging), verwijder de ' in onderstaande regel (gedaan!). Print naar Direct scherm (Ctrl+G).
        Debug.Print strWhere
        
        'En dan uiteindelijk, pas de string aan de formulier filter.
        Me.Filter = strWhere
        Me.FilterOn = True
    End If
End Sub

Private Sub cmdPrintZkJournaal_Click()
    
    Dim strRapport As String
    Dim strWhere As String
    Dim lngLen As Long
    Const conJetDate = "\#mm\/dd\/yyyy\#"
    
    strRapport = "RapportZkJournaal"
   
    If Not IsNull(Me.TxtPlaats) Then
        strWhere = strWhere & "([PLAATS] = """ & Me.TxtPlaats & """) AND "
    End If
    
    If Not IsNull(Me.TxtJournaal) Then
        strWhere = strWhere & "([Journaal] Like ""*" & Me.TxtJournaal & "*"") AND "
    End If
    
    If Not IsNull(Me.TxtStartdatum) Then
        strWhere = strWhere & "([datum] >= " & Format(Me.TxtStartdatum, conJetDate) & ") AND "
    End If
    
    If Not IsNull(Me.TxtEinddatum) Then   'Less than the next day.
        strWhere = strWhere & "([datum] < " & Format(Me.TxtEinddatum + 1, conJetDate) & ") AND "
    End If
 
    If CurrentProject.AllReports(strRapport).IsLoaded Then
        DoCmd.Close acReport, strRapport
    End If
    

    DoCmd.OpenReport strRapport, acViewNormal, , strWhere

Exit_Handler:
    Exit Sub

Err_Handler:
    If Err.Number <> 2501 Then
        MsgBox "Foutmelding " & Err.Number & ": " & Err.Description, vbExclamation, "Rapportfout."
    End If
    Resume Exit_Handler
 
End Sub

Private Sub cmdReset_Click()
    'Doel:   Vernieuw alle zoekvelden in de Form Header, en laat alle records weer zien.
    Dim ctl As Control
    
    'Wis alle controls in de Form Header sectie.
    For Each ctl In Me.Section(acHeader).Controls
        Select Case ctl.ControlType
        Case acTextBox, acComboBox
            ctl.Value = Null
        Case acCheckBox
            ctl.Value = False
        End Select
    Next
    
    'Verwijder alle form's filter.
    Me.FilterOn = False
End Sub

Private Sub Form_BeforeInsert(Cancel As Integer)
    'Om problemen te voorkomen dat na invoer geen records te zien zijn, is AllowAdditions niet aangepast naar Nee.
    'Er kan ook geen nieuwe records aangemaakt worden door BeforeInsert te annuleren.
    'Voor verdere problemen/issues, zie http://allenbrowne.com/bug-06.html
    Cancel = True
    MsgBox "U kunt geen nieuwe records toevoegen in het zoekformulier.", vbInformation, "Systeembeveiliging."
End Sub

Private Sub Form_Open(Cancel As Integer)
    'Verwijder de ' quote van de navolgende regels wanneer je geen records wilt tonen.
    'Me.Filter = "(False)"
    'Me.FilterOn = True
End Sub
 
Grappig dat je jezelf meer credit geeft dan Allen Browne, die als 'tweede' auteur wordt genoemd. Behalve de veldnamen heb je volgens mij niet zoveel veranderd aan zijn code. Ik weet niet of het aanpassen van een veldnaam voldoende is om auteursrechten te claimen ;)
Overigens kan de code nog wat netter; de code met de AND structuur vind ik niet zo netjes. En dit

1. Ik label " AND " aan het einde van elke "condition" om daarmee sneller nieuwe zoekvelden toe te kunnen voegen;

is ook bepaald twijfelachtig. Ik zou een behoorlijk oud systeem moeten opstarten om dat verschil met deze code te meten:
Code:
    'Nog een tekstveld voorbeeld. Gebruik Like om willekeurig te zoeken in het veld.
    If Not Me.TxtJournaal = vbNullString Then
        If Not strWhere = "" Then strWhere = strWhere & " AND "
        strWhere = strWhere & "([Journaal] Like ""*" & Me.TxtJournaal & "*"")"
    End If

Je raportprobleem is heel simpel op te lossen:
Code:
Private Sub cmdPrintZkJournaal_Click()
Dim strRapport As String
    
    strRapport = "RapportZkJournaal"
    If CurrentProject.AllReports(strRapport).IsLoaded Then
        DoCmd.Close acReport, strRapport
    End If
    DoCmd.OpenReport strRapport, acViewNormal, , Me.Filter
End Sub
 
Dank alweer, OctaFish.

Al ruim drie dagen (ik zal maar niet zeggen hoeveel uur) ben ik bezig om de juiste vba code te gebruiken. Ik had wel, zoals inderdaad de auteur van mijn voorbeeld, ipv me.Filter had ik strWhere geplaatst en kreeg daar de foutmeldingen constant op. Vervolgens heb ik waarschijnlijk de code foutief herschreven (gedeelte van cmdZoekJournaal).

En ja, dat is inderdaad niet netjes geschreven zoals jij het nu voorschoteld :). Heb daar niet bij stilgestaan, maar goed dat je me daar op attendeert.

Je eerste genoteerde code ken ik niet, maar zoals altijd is het wijselijk om die te gaan gebruiken. Dus daar ga ik wederom de studieboeken (of internet haha) op.
 
Laatst bewerkt:
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan