Rapport uit Query

Status
Niet open voor verdere reacties.
T

tobo100

Gebruiker
Lid geworden
14 okt 2013
Berichten
153
hallo allemaal
ben alweer een poosje bezig (lees dagen) om een rapport te openen op basis van een query
ik dacht ik maak een knop en en dan lees ik alle waardes uit de text / combobox opnieuw in maar dan doe je de dingen 2x
niet handig dus
later kwam ik er achter dat alle waardes al worden aan gegeven in de onderstaande (bestaande)code
nu probeer ik een querystring te maken zo dat als je iets in typt er automatisch een query string word gegenereerd
die ik dan als ik zou willen in het rapport terug zie dmv een knop
in het rood is de door mij toegevoegde en niet werkende code


Bekijk bijlage Filteren Uitgebreid V31B.rar

Code: 
[COLOR="#FF0000"]Dim MyDB As DAO.Database
Dim qdef As DAO.QueryDef
Dim strSQL As String[/COLOR]

Me.Filter = sFilter
Me.FilterOn = True
[COLOR="#FF0000"]MyDB.QueryDefs.Delete "query1"
strSQL = "SELECT * FROM blad1" & Me.Filter & ""
Set qdef = MyDB.CreateQueryDef("query1", strSQL)
[/COLOR]

If Not Zoekveld = "" Then
    Me(Zoekveld).SetFocus
 
Ik snap niet helemaal wat je aan het doen bent. Zo verwijder je een query die je even later weer aanmaakt. Heeft weinig zin, aangezien je de query daarna weer aanmaakt. Veel logischer dus om de SQL van de query aan te passen. Daarnaast mist er een spatie achter Blad1, waardoor je filter tegen de tabelnaam aan wordt geplakt, wat uiteraard niet mag. Belangrijker nog: ik vermoed dat je filter niet het WHERE argument heeft, omdat je het filter uit het formulier haalt. Dus de code zou zo kunnen zijn:
Code: 
Dim strSQL As String
Dim qDef As DAO.QueryDef

    Me.Filter = sFilter
    Me.FilterOn = True
    Set qDef = CurrentDb.QueryDefs("Query1")
    strSQL = "SELECT * FROM blad1 WHERE " & sFilter
    qDef.SQL = strSQL
 
geweldig michel werkt ook gelijk weer
heb nu alleen nog een probleem met de listbox
die heeft bij extra info: de naam JAAR en niet en niet de veld naam [geboortedatum]
kun je me uitleggen hoe ik dat moet veranderen? in de listbox moet ook nog "All" aangevinkt kunnen worden
vast bedankt Gr tobo
 
All zit niet in een listbox, en heeft denk ik ook niet zoveel zin. Als je filtert op alle waarden uit een keuzelijst, filter je namelijk niet op die keuzelijst. Dus wat is het nut ervan dan? Als je de keuzelijst op een ander veld wilt laten werken, dan kun je gewoon de veldnaam in het veld <Extra Info> vervangen. Da's een kwestie van typen.
 
ik heb de naam JAAR alverandert maar ik hou foutmelding

volgens mij moet "iets" als dit tussen geplaatst worden
maar ik heb geen idee hoe ik dat werkend tussen krijg

Code: 
year([geboortedatum]) IN (" & Left(strIN, Len(strIN) - 1) & ")"
 
Laatst bewerkt:
Je informatie is te summier om er verder iets zinnigs van te zeggen, als dat het niet is. <Extra Info> gebruik je om de veldnaam waarop je filtert vast te leggen. Omdat je de keuzelijst filtert op meerdere waarden, en die hard in een string zet, en ook het filter hard op de veldnaam programmeert, doet de Tag niets. Tenzij je de tag in andere filters nog gebruikt. Maar dan moet ik meer zien.
 
de bedoeling is om een query te maken van de waardes die uit "Me.Filter = sFilter" komen
"Me.Filter = sFilter" filtert nu een formulier en die waardes zou ik graag willen gebruiken om via een query een rapport te maken
die de zelfde waardes geeft als als het formulier zelf
het voorbeeld bestand staat onder #1
 
HEt goede voorbeeld staat in bericht #2 :).
Mits uiteraard sFilter het juiste criterium bevat. Maar dat kunnen wij zo niet zien. Ik zou zeggen:vang de query eens af met
Code: 
    Set qDef = CurrentDb.QueryDefs("Query1")
    strSQL = "SELECT * FROM blad1 WHERE " & sFilter
    dim tmp As String
    tmp = InputBox("","",strSQL)
    qDef.SQL = strSQL
En controleer in een nieuwe query of hij ook werkt. En laat het resultaat van de string eens zien, dan zien we gauw genoeg of er een fout in zit. Iets dat nu niet kan.
 
SELECT * FROM blad1 WHERE [Achternaam] Like "a*"
SELECT * FROM blad1 WHERE [Achternaam] Like "a*" AND [Jaar] = 2006
SELECT * FROM blad1 WHERE [Achternaam] Like "a*" AND [Jaar] =2006 OR [Jaar] =2008
SELECT * FROM blad1 WHERE [Achternaam] Like "a*" AND [Jaar] = 1999

SELECT * FROM blad1 WHERE [Geboortedatum] Like "all*"

SELECT * FROM blad1 WHERE [Achternaam] Like "a*" AND [Jaar] =2006 OR [Jaar] =2008
SELECT * FROM blad1 WHERE [Voornaam] Like "d*" AND [Achternaam] Like "a*" AND [Jaar] =2006 OR [Jaar] =2008 OR [Jaar] =2014


Bekijk bijlage Filteren Uitgebreid V31B1.rar
 
En wat is nu je probleem? Volgens mij filtert-ie prima. Afgezien natuurlijk van de onnodige optie All in de keuzelijst met jaren, want niet alleen zie je alle jaren als je niks selecteert: all is geen getal, en derhalve ook onbruikbaar.
 
het probleem is dat het niet werkt in de query zo als reeds beschreven onder #1
bv: veld [Geboortejaar] Like "2006*" geef geen Query1 resultaten
volgens mij word jaartal 2006 ook niet als nummeriek gefilterd anders komt er geen * achter te staan
 
En dat is hartstikke logisch, want [Geboortedatum] is een datum, geen getal. Je query zou er zo uit moeten zien:
Code: 
SELECT * FROM blad1
WHERE ((Voornaam Like "d*") AND (Achternaam Like "a*") 
AND ((Year([geboortedatum]))=2006 Or (Year([geboortedatum]))=2008 Or (Year([geboortedatum]))=2014));
 
Laatst bewerkt:
Je moet 2 dingen aanpassen: de eigenschap <Extra Info> op de keuzelijst die jaartallen laat zien, moet in de TAG ofwel het veld laten zien waarop je filtert, ofwel de functie. In jouw geval moet je uit de geboortedatum een jaartal genereren, en daar filter je op. Omdat de functie nooit kan weten wanneer een veld moet worden omgezet naar iets anders, moet je dat zelf bepalen. Maar dat is ook het mooie van het TAG veld: je kunt daar neerzetten wat je wilt. Dus ook: Year([Geboortedatum]). En dat is exact wat er moet komen te staan. Nu kan het filter wel bepalen wat er moet gebeuren.

Daarnaast heb ik de filterfunctie aangepast, want er ging nog iets niet helemaal goed. Kan ook altijd beter natuurlijk :). Hier de aangepaste versie, met in Vet wat ik heb veranderd. Ik heb ook de variabelen een beetje geschoond, want dat kon ook netter. Maar die wijzigingen laat ik gewoon hier staan.
Code: 
Private Function CheckFilter(Optional Zoekveld As String, Optional Waarde As String)
Dim sFilter As String, [B][COLOR="#0000FF"]tmpFilter As String[/COLOR][/B], sFilters() As String, sTekst() As String
Dim strSQL As String, sAndOr As String, sKeuze As String
Dim ctl As Control
Dim tmpMatrix As Variant, tmp As Variant, itm As Variant
Dim iFltr As Integer, iLst As Integer
Dim MyDB As DAO.Database
Dim qdef As DAO.QueryDef
Dim rst As DAO.Recordset

    '-----------------------------------------------------------------------------------------------------------
    'Eerst de grootte van de matrix bepalen....
    'Dat doen we door alle filters door te lopen, en de inhoud in een matrix te zetten.
    'We lopen door de controls heen op basis van het ControlType.
    '-----------------------------------------------------------------------------------------------------------
    x = 0: iFltr = 0: iLst = 0
    
    For Each ctl In Controls
        With ctl
            Select Case .ControlType
                Case acTextBox
                    If LCase(Left(.Name, 9)) = "txtFilter" Then
                        .SetFocus
                        iFltr = iFltr + 1
                        On Error Resume Next
                        If Not .Text = "" Then
                            x = x + 1
                            If x = 1 Then
                                ReDim sTekst(x)
                            Else
                                ReDim Preserve sTekst(x)
                            End If
                            '-----------------------------------------------------------------------------------
                            'De matrix wordt gevuld met de Veldnaam, de Filternaam en het Filterveld.
                            'Deze worden met een scheidingsteken in één string gezet die later gesplitst wordt.
                            '-----------------------------------------------------------------------------------
                            sTekst(x) = .Tag & "|" & .Text & "|" & .Name
                        End If
                    End If
                Case acListBox
                    '-------------------------------------------------------------------------------------------
                    'Een listbox kan meerdere items bevatten die geselecteerd worden.
                    'Die moeten allemaal apart worden uitgelezen.
                    '-------------------------------------------------------------------------------------------
                    If LCase(Left(.Name, 9)) = "lstFilter" Then
                        sKeuze = ""
                        .SetFocus
                        iFltr = iFltr + 1
                        iLst = iLst + 1
                        On Error Resume Next
                        If Me("lstFilter" & iLst).ItemsSelected.Count >= 1 Then
                            x = x + 1
                            If x = 1 Then
                                ReDim sTekst(x)
                            Else
                                ReDim Preserve sTekst(x)
                            End If
                            For Each itm In Me("lstFilter" & iLst).ItemsSelected
                                If sKeuze & "" <> "" Then sKeuze = sKeuze & "\"
                                sKeuze = sKeuze & Me("lstFilter" & iLst).ItemData(itm)
                            Next itm
                            '-----------------------------------------------------------------------------------
                            'Ook hier wordt een samengestelde string gemaakt van de filterwaarden.
                            '-----------------------------------------------------------------------------------
                            sTekst(x) = .Tag & "|" & sKeuze & "|" & .Name
                        End If
                    End If
                Case acComboBox
                    If LCase(Left(.Name, 9)) = "cboFilter" Then
                        .SetFocus
                        iFltr = iFltr + 1
                        On Error Resume Next
                        If Not .Value = "" Then
                            x = x + 1
                            If x = 1 Then
                                ReDim sTekst(x)
                            Else
                                ReDim Preserve sTekst(x)
                            End If
                            sTekst(x) = .Tag & "|" & .Text & "|" & .Name
                        End If
                    End If
            End Select
        End With
    Next ctl
    
    '-----------------------------------------------------------------------------------------------------------
    'Als de tekstfilters leeg zijn, dan filter leegmaken en stoppen....
    '-----------------------------------------------------------------------------------------------------------
    If x = 0 Then GoTo LeegFilter
    '...... anders doorgaan, en matrix herdefiniëren.
    '===========================================================================================================
    
    '-----------------------------------------------------------------------------------------------------------
    'Dan de variabelen vullen met gegevens
    'We doen dat door een extra matrix te maken op basis van het filter
    '-----------------------------------------------------------------------------------------------------------
    ReDim sFilters(x, 3)
    For i = LBound(sFilters) To UBound(sFilters)
        tmpMatrix = Split(sTekst(i), "|")
        For x = LBound(tmpMatrix) To UBound(tmpMatrix)
            sFilters(i, x + 1) = tmpMatrix(x)
        Next x
    Next i
    i = 0
    x = 0
    '===========================================================================================================
    
    '-----------------------------------------------------------------------------------------------------------
    'Dan op basis van de variabelen het filter opbouwen
    '-----------------------------------------------------------------------------------------------------------
    Select Case Me.fraOptie.Value
        Case 1
            sAndOr = " AND "
        Case 2
            sAndOr = " OR "
    End Select
    
[B][COLOR="#0000FF"]    sFilter = "": tmpFilter = ""
[/COLOR][/B]    For i = LBound(sFilters) To UBound(sFilters)
        If LBound(sFilters) = UBound(sFilters) Then
            If InStr(sFilters(i, 2), "\") > 0 Then           '=,> 0    maakt er altijd text veld van
                tmpMatrix = Split(sFilters(i, 2), "\")
                For x = LBound(tmpMatrix) To UBound(tmpMatrix)
                    '-------------------------------------------------------------------------------------------
                    'Eerst controleren of er getallen in het spel zijn, of tekst.
                    '-------------------------------------------------------------------------------------------
                    If IsNumeric(tmpMatrix(x)) Then
                        sFilter = sFilter & "[" & sFilters(i, 1) & "] =" & tmpMatrix(x)
                    Else
                        sFilter = sFilter & "[" & sFilters(i, 1) & "] Like """ & tmpMatrix(x) & "*"""
                    End If
                    If x < UBound(tmpMatrix) Then sFilter = sFilter & " OR "
                Next x
            Else
                sFilter = sFilter & "[" & sFilters(i, 1) & "] Like """ & sFilters(i, 2) & "*"""
             End If
        Else
            '---------------------------------------------------------------------------------------------------
            'Vervolgens controleren of de listbox meerdere items bevat, die gesplitst moeten worden.
            'Die worden dan allemaal apart worden uitgelezen en in het filter gezet.
            '---------------------------------------------------------------------------------------------------
            If InStr(sFilters(i, 2), "\") > 0 Then     '=,> 0    maakt er altijd text veld van
                tmpMatrix = Split(sFilters(i, 2), "\")
[B][COLOR="#0000FF"]                tmpFilter = ""[/COLOR][/B]
                For x = LBound(tmpMatrix) To UBound(tmpMatrix)
                    '-------------------------------------------------------------------------------------------
                    'Uiteraard ook hier weer controleren of er getallen in het spel zijn, of tekst.
                    '-------------------------------------------------------------------------------------------
                    If IsNumeric(tmpMatrix(x)) Then
                        [B][COLOR="#FF0000"]If InStr(sFilters(i, 1), "[") > 0 Then[/COLOR][/B]
                            [B][COLOR="#0000FF"]tmpFilter = tmpFilter & sFilters(i, 1) & "=" & tmpMatrix(x)
                        ElseIf InStr(sFilters(i, 1), "[") = 0 And InStr(sFilters(i, 1), " ") > 0 Then
                            tmpFilter = tmpFilter & "[" & sFilters(i, 1) & "] =" & tmpMatrix(x)
                        End If
                    Else
                        tmpFilter = tmpFilter & "[" & sFilters(i, 1) & "] """ & tmpMatrix(x) & "*"""
                    End If
                    If x < UBound(tmpMatrix) Then tmpFilter = tmpFilter & " OR "
                Next x
            Else
                If IsNumeric(sFilters(i, 2)) Then
                    tmpFilter = "[" & sFilters(i, 1) & "] = " & sFilters(i, 2)
                Else
                    tmpFilter = "[" & sFilters(i, 1) & "] Like """ & sFilters(i, 2) & "*"""
                End If
            End If
            sFilter = sFilter & "(" & tmpFilter & ")"
            If i < UBound(sFilters) Then
                sFilter = sFilter & sAndOr
            End If
        End If[/COLOR][/B]
    Next i
    '===========================================================================================================

    '-----------------------------------------------------------------------------------------------------------
    'Filter vervolgens op formulier toepassen.
    '-----------------------------------------------------------------------------------------------------------
    Set qdef = CurrentDb.QueryDefs("Query1")
        strSQL = "SELECT * FROM blad1 WHERE " & sFilter
        qdef.SQL = strSQL
        
    Me.Filter = sFilter
    Me.FilterOn = True
    MyDB.QueryDefs.Delete "query1"
    strSQL = "SELECT * FROM blad1" & Me.Filter & ""
    Set qdef = MyDB.CreateQueryDef("query1", strSQL)
    
    If Not Zoekveld = "" Then
        Me(Zoekveld).SetFocus
    End If
    '===========================================================================================================
    
    '-----------------------------------------------------------------------------------------------------------
    'En als laatste functie om de verticale scrollbar aan- of uit te zetten.
    '-----------------------------------------------------------------------------------------------------------
    CheckScrollbar
    '===========================================================================================================

Exit Function

LeegFilter:
    Me.Filter = ""
    Me.FilterOn = False
    On Error Resume Next
    Me(Zoekveld).SetFocus

End Function
 
Laatst bewerkt:
ik heb de aanpassingen gemaakt en heb nu een overschot aan hekjes


tmpFilter = tmpFilter & "[" & sFilters(i, 1) & "] =" & tmpMatrix(x)
' resulteerd in

WHERE ([Patent-nr] = 1) AND ([Year([Geboortedatum])] = 2006*)"

haal ik de blauwe hekjes weg dan:
WHERE (Patent-nr = 1) AND (Year([Geboortedatum])= 2006*)"
 
Laatst bewerkt:
Er zit een check bij op rechte haken, al was de eerste regel van die extra IF niet blauw gemaakt. Hij is nu rood in de code. Maar als je de hele functie gebruikt dan zou het moeten werken. Ik heb 'm gisteren in ieder geval goed kunnen testen zo. Als ik een filter maak, krijg je dit:
Code: 
SELECT * FROM blad1
WHERE ([Voornaam] Like "d*") AND ([Achternaam] Like "a*") AND (Year([Geboortedatum])=2006 OR Year([Geboortedatum])=2008);
in de query. En dat is dus helemaal goed.
 
het werkt nu helemaal zou als ik wou
helemaal te gek dankjewel Michel !!
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan