Listbox

  • Onderwerp starter Onderwerp starter ran
  • Startdatum Startdatum
Status
Niet open voor verdere reacties.
R

ran

Gebruiker
Lid geworden
22 dec 2006
Berichten
58
Ik wil graag mbv 3 listboxen een een rapport maken.
Ik weet vrijwel niks van vba. Overal lees ik dat dit alleen met vba kan. Hoe kan ik dit maken?

De velden zijn: activiteit, weeknummer en jaar.
De tabel table2
De query qrymultiselect
 
Het kan eventueel wel zonder VBA, maar je bent wat minder flexibel. Ik neem aan dat je het rapport afvuurt vanaf een formulier, want anders kun je ook geen keuzelijsten gebruiken. Het zou dan ongeveer zo kunnen werken:
1. Maak je keuzelijsten op het formulier, en geef ze een fatsoenlijke naam, dus niet: [Keuzelijst met invoervak125], wat de naam is als je de wizard gebruikt. Het mag overigens wel, maar straks weet je echt niet meer welke 'naamloze' keuzelijst welk veld filtert.... Verander de naam dus bij de <Eigenschappen> op het tabblad <Overige>. Bijvoorbeeld naar cboActiviteit, cboWeeknummer etc.
2. Open, terwijl het formulier ook geopend is, je rapport in het Ontwerpscherm.
3. Open de query die je als basis voor het rapport gebruikt via <Eigenschappen>, <Recordbron>. Heb je een tabel, maak dan een query aan op basis van die tabel.
4. zet de cursor in de regel Criteria van het veld waarop je wilt filteren, en druk op <Ctrl>+<F2>. Daarmee open je <Opbouwfunctie voor Expressies.
5. Dubbelklik op <Forms>, <Geladen Formulieren>, en selecteer het formulier met de keuzelijsten.
6. Selecteer de juiste keuzelijst, en klik op Plakken. Je krijgt dan een formule als: Forms![Frm_Patient]![cboActiviteit]. Nu zie je hoe handig het is als de keuzelijsten een fatsoenlijke naam hebben ;)
Maak de rest af, door de schermen te sluiten en op te slaan.
7. Herhaal het proces vanaf regel 4 voor de overige keuzelijsten.

Als het goed is, kun je het rapport nu openen met de gefilterde waarden uit je formulier.
 
Het werkt, alleen niet in de "multi select(simple)" vorm. Het zou juist moeten zijn dat er
meerdere dingen aangeklikt moeten kunnen worden.. Kan dit met alleen gebruik van Access? Een item "alles selecteren" ontbreekt nog kan dit worden gemaakt?
 
Nu wordt het wat ingewikkelder.... het uitlezen van een meervoudige Keuzelijst kan alleen via VBA. Dat niet alleen, je zult dan ook een filterstring moeten opbouwen, en ook dat kan eigenlijk alleen maar via VBA. Een optie <Alles selecteren> kun je het makkelijkst ook via VBA maken, bijvoorbeeld door een extra checkbox te maken: Alles selecteren. Deze krijgt dan bijvoorbeeld deze code:

Code: 
Private Sub chkAllActiviteiten_AfterUpdate()
If Me.chkAllActiviteiten.Value = -1 Then
    For x = 0 To Me.lstActiviteiten.ListCount - 1
         Me.lstActiviteiten.Selected(x) = True
    Next x
Else
    For x = 0 To Me.lstActiviteiten.ListCount - 1
         Me.lstActiviteiten.Selected(x) = False
    Next x
End If
End Sub
 
Ik heb creatief gegoogled en heb deze code bevonden.
De items die van toepassing zijn:
knop: openquery
listbox1: lstactiviteiten
listbox2: lstweeknr
listbox3:lstjaar

tabel 2 met velden: activiteiten, weeknr_Id en jaar_id
Query: qryselectie
Wat moet in de query staan?
Volgens mij heb ik de code aardig ingevuld
Echter krijg ik steeds een foutmelding: "item not found in this collection"

Code: 
Private Sub openquery_Click()



On Error GoTo Err_openQuery_Click
Dim MyDB As DAO.Database
Dim qdef As DAO.QueryDef
Dim i As Integer
Dim strSQL As String
Dim strWhere As String
Dim strWhere1 As String
Dim strWhere2 As String
Dim strWhere3 As String
Dim strIN As String
Dim flgSelectAll As Boolean
Dim varItem As Variant

Set MyDB = CurrentDb()

strSQL = "SELECT * FROM table2"

'Build the IN string by looping through the first listbox
For Each varItem In lstactiviteiten.ItemsSelected
If lstactiviteiten.Column(0, varItem) = " All" Then
flgSelectAll = True
Exit For
End If
strIN = strIN & "'" & lstactiviteiten.Column(0, varItem) & "',"
Next varItem

'Create the WHERE string, and strip off the last comma of the IN string
' If "All" was selected, don't create the WHERE string
If flgSelectAll1 = False Then
strWhere1 = " [activiteiten] IN (" & Left(strIN, Len(strIN) - 1) & ")"
Else
strWhere1 = ""
End If

strIN = ""
flgSelectAll = False
'Build the IN string by looping through the second listbox
For Each varItem In lstweeknr.ItemsSelected
If lstweeknr.Column(0, varItem) = " All" Then
flgSelectAll = True
Exit For
End If
strIN = strIN & "'" & lstweeknr.Column(0, varItem) & "',"
Next varItem

'Create the WHERE string, and strip off the last comma of the IN string
' If "All" was selected, don't create the WHERE string
If flgSelectAll = False Then
strWhere2 = " WHERE [weeknr_ID] IN (" & Left(strIN, Len(strIN) - 1) & ")"
Else
strWhere2 = ""
End If

strIN = ""
flgSelectAll = False
'Build the IN string by looping through the third listbox
For Each varItem In lstjaar.ItemsSelected
If lstjaar.Column(0, varItem) = " All" Then
flgSelectAll = True
Exit For
End If
strIN = strIN & "'" & lstjaar.Column(0, varItem) & "',"
Next varItem

'Create the WHERE string, and strip off the last comma of the IN string
' If "All" was selected, don't create the WHERE string
If flgSelectAll = False Then
strWhere3 = " WHERE [jaar_ID] IN (" & Left(strIN, Len(strIN) - 1) & ")"
Else
strWhere3 = ""
End If

' Build the overall WHERE clause
If Len(strWhere1) > 0 Then
strWhere = strWhere1
End If
If Len(strWhere2) > 0 Then
If Len(strWhere) > 0 Then
strWhere = strWhere & " AND " & strWhere2
Else
strWhere = strWhere2
End If
End If
If Len(strWhere3) > 0 Then
If Len(strWhere) > 0 Then
strWhere = strWhere & " AND " & strWhere3
Else
strWhere = strWhere3
End If
End If
If Len(strWhere) > 0 Then
strSQL = strSQL & " WHERE " & strWhere
End If

MyDB.QueryDefs.Delete " qrymultiselect "
Set qdef = MyDB.CreateQueryDef("qrymultiselect", strSQL)

'Open the query, built using the IN clause to set the criteria
DoCmd.openquery " qryselectie ", acViewNormal

'Clear listbox selection after running query
For Each varItem In Me.lstactiviteiten.ItemsSelected
Me.lstactiviteiten.Selected(varItem) = False
Next varItem


Exit_openQuery_Click:
Exit Sub

Err_openQuery_Click:

If Err.Number = 5 Then
MsgBox "Please make a selection from each list", , "Selection Required !"
Resume Exit_openQuery_Click
Else
'Write out the error and exit the sub
MsgBox Err.Description
Resume Exit_openQuery_Click
End If

End Sub
 
En waar stopt hij dan? Ik zie namelijk wel een foutje....
 
Zeg eerst maar waar hij stopt...
 
Na het openen van de query of het rapport.. is dat niet gewoon de laatste regel met de foutmelding.
Hij gaat de 3 boxen langs en kijkt of ze gevuld zijn. Daarna start de selectie. Of is dit niet wat je bedoeld?
 
Als je een foutmelding krijgt, kun je met <Foutopsporing> zien waar het fout gaat. Maar blijkbaar doet hij bij jou alles prima, want hij opent de query. Dus dan snap ik niet helemaal waarom je een foutmelding krijgt.
 
Wanneer ik de vba code "run" kan ik 'm opslaan als macro..
Waar zat volgens jou de fout dan? Kan het simpeler?
 
Jij krijgt een foutmelding, zeg je zelf. Derhalve zit er een fout in. En je hebt nog steeds niet aangegeven bij welke regel....
 
De foutmelding krijg ik wanneer ik op de knop druk.
Hij stopt nergens wanneer ik de code""debug". Bij een andere code geeft hij aan dat een verwijzing fout is.
Ik heb een bijlage toegevoegd..
 

Bijlagen

Nu je een voorbeeldje hebt gemaakt, kan ik wat beter aangeven wat er allemaal aan schort...
Om te beginnen: vergelijk deze twee strings eens...

SELECT * FROM table2 WHERE [activiteiten] IN ('Voetbal') AND WHERE [weeknr_ID] IN ('2') AND WHERE [jaar_ID] IN ('1')
SELECT * FROM table2 WHERE ([Activiteiten] In ('voetbal')) AND ([Jaar_ID] In (1)) AND ([Weeknr_ID] In (2));

De bovenste is zoals jij hem opbouwt, en die overigens niet werkt; de tweede is van mij en die werkt wel.
In een SQL string mag je maar één WHERE gebruiken; jij hebt er 3 staan. Foutje 1. Volgende fout: bij jou staan de weekwaarden tussen quootjes, en hetzelfde geldt voor het JaarID. Dit zijn echter getallen, en die gebruik je zonder aanhalingstekens.
Dus dat moet je in ieder geval aanpassen, anders gaat het nooit werken. Verder zit er nog een foutje in, al zou je die bij een werkend systeem niet tegenkomen. En wel hier:

MyDB.QueryDefs.Delete "qrymultiselect"
Set qdef = MyDB.CreateQueryDef("qrymultiselect", strSQL)

Wat doe je hier? je gooit een querydefinitie ("qrymultiselect") weg. Maar wat nu als die niet bestaat? Kan je hem ook niet weggooien, en dat levert dus een foutmelding op. Je lost dat op door de volgende regel er boven te zetten:

On Error Resume Next
MyDB.QueryDefs.Delete "qrymultiselect"
Set qdef = MyDB.CreateQueryDef("qrymultiselect", strSQL)

Hiermee forceer je dat Access doorgaat met de volgende regel, en wordt de query dus ook daadwerkelijk aangemaakt. Zitten we dus al op drie fouten ;)

En dit is er volgens mij ook nog een:
Heb je dus net een mooie query aangemaakt, doe je er niks mee? Want je opent vervolgens een hele andere query...
DoCmd.openquery " qryselectie ", acViewNormal

Pak er een bakkie pleur bij, en maak er wat moois van, zou ik zeggen :)
 
Bedankt!

Het is helaas nog niet gelukt.
Die string aanpassen heb ik denk ik fout gedaan, weet niet hoe dat moet..
 

Bijlagen

Deze werkt.

Code: 
Private Sub OpenQuery_Click()

On Error GoTo Err_openQuery_Click
Dim MyDB As DAO.Database
Dim qdef As DAO.QueryDef
Dim i As Integer
Dim strSQL As String
Dim strWhere As String, strWhere1 As String, strWhere2 As String, strWhere3 As String
Dim strIN As String
Dim flgSelectAll As Boolean, bSelect1 As Boolean, bSelect2 As Boolean, bSelect3 As Boolean
Dim varItem As Variant

Set MyDB = CurrentDb()

strSQL = "SELECT * FROM table2 "

'Build the IN string by looping through the first listbox
For Each varItem In lstactiviteiten.ItemsSelected
    If lstactiviteiten.Column(0, varItem) = " All" Then
        flgSelectAll = True
        Exit For
    End If
    If IsNumeric(lstactiviteiten.Column(0, varItem)) Then
        strIN = strIN & lstactiviteiten.Column(0, varItem) & ","
    Else
        strIN = strIN & "'" & lstactiviteiten.Column(0, varItem) & "',"
    End If
    bSelect1 = True
Next varItem

'Create the WHERE string, and strip off the last comma of the IN string
' If "All" was selected, don't create the WHERE string
If flgSelectAll = False Then
    strWhere1 = " [activiteiten] IN (" & Left(strIN, Len(strIN) - 1) & ")"
Else
    strWhere1 = ""
End If

strIN = ""
flgSelectAll = False
'Build the IN string by looping through the second listbox
For Each varItem In lstweeknr.ItemsSelected
    If lstweeknr.Column(0, varItem) = " All" Then
        flgSelectAll = True
        Exit For
    End If
    If IsNumeric(lstweeknr.Column(0, varItem)) Then
        strIN = strIN & lstweeknr.Column(0, varItem) & ","
    Else
        strIN = strIN & "'" & lstweeknr.Column(0, varItem) & "',"
    End If
    bSelect2 = True
Next varItem

'Create the WHERE string, and strip off the last comma of the IN string
' If "All" was selected, don't create the WHERE string
If flgSelectAll = False Then
    strWhere2 = " [weeknr_ID] IN (" & Left(strIN, Len(strIN) - 1) & ")"
Else
    strWhere2 = ""
End If

strIN = ""
flgSelectAll = False
'Build the IN string by looping through the third listbox
For Each varItem In lstJaar.ItemsSelected
    If lstJaar.Column(0, varItem) = " All" Then
        flgSelectAll = True
        Exit For
    End If
    If IsNumeric(lstJaar.Column(0, varItem)) Then
        strIN = strIN & lstJaar.Column(0, varItem) & ","
    Else
        strIN = strIN & "'" & lstJaar.Column(0, varItem) & "',"
    End If
    bSelect3 = True
Next varItem

'Create the WHERE string, and strip off the last comma of the IN string
' If "All" was selected, don't create the WHERE string
If flgSelectAll = False Then
    strWhere3 = " [jaar_ID] IN (" & Left(strIN, Len(strIN) - 1) & ")"
Else
    strWhere3 = ""
End If

' Build the overall WHERE clause
If Len(strWhere1) > 0 Then strWhere = strWhere1
If Len(strWhere2) > 0 Then
    If Len(strWhere) > 0 Then
        strWhere = strWhere & " AND " & strWhere2
    Else
        strWhere = strWhere2
    End If
End If
If Len(strWhere3) > 0 Then
    If Len(strWhere) > 0 Then
        strWhere = strWhere & " AND " & strWhere3
    Else
        strWhere = strWhere3
    End If
End If
If Len(strWhere) > 0 Then
    strSQL = strSQL & " WHERE " & strWhere
End If

''Dim tmp
''tmp = InputBox("", "", strSQL)
On Error Resume Next
MyDB.QueryDefs.Delete "qryMultiselect"
Set qdef = MyDB.CreateQueryDef("qryMultiselect", strSQL)

'Open the query, built using the IN clause to set the criteria
DoCmd.openquery "qryMultiselect", acViewNormal

'Clear listbox selection after running query
For Each varItem In Me.lstactiviteiten.ItemsSelected
    Me.lstactiviteiten.Selected(varItem) = False
Next varItem

Exit_openQuery_Click:
Exit Sub

Err_openQuery_Click:

If Err.Number = 5 Then
MsgBox "Please make a selection from each list", , "Selection Required !"
Resume Exit_openQuery_Click
Else
'Write out the error and exit the sub
MsgBox Err.Description
Resume Exit_openQuery_Click
End If

End Sub
 
Ik heb nog een vraagje.
Een keuze om alles te selecteren ontbreekt maar staat volgens mij wel in de code.
Hoe activeer je die?
 
Je moet daarvoor de rijbron van je keuzelijsten aanpassen. Ik heb er alvast ééntje voor je gedaan. De rest kun je zelf wel. Toch?

Code: 
SELECT DISTINCT "All" 
FROM Table2
UNION ALL
SELECT DISTINCT Weeknr_ID
FROM Table2
WHERE (Weeknr_ID Is Not Null)
 
Hij doet het voor alle lijsten niet..
"All" is wel zichtbaar in de lijsten, de knop werkt echter niet.
Als je erop klikt gaat wordt de keuze in de activiteiten lijst gedeselecteerd.
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan