meerdere recordvelden in een rapport horizontaal in 1 regel combineren

[Friend]

Beste allemaal,
Een vraag, ik heb 2 tabellen : 1e naam / 2e werkopdracht. Gekoppeld aan elkaar via het veld ID. Nu wil ik een rapport uitdraaien (gegevens vanuit query waar de 2 tabellen worden samengevoegd) op naam met daar onder de (meerdere) werkopdrachten per persoon. Dat is ook allemaal geen probleem. Alleen in het rapport staan de werkopdrachten onder elkaar. Dit neemt veel ruimte/pagina's. Ik zoek de oplossing om de verschillende werkopdrachten per naam in een regel te laten uitvullen.

een voorbeeld van het rapport nu :

Wim Jansen
--------------------------
autowassen
auto aftanken
autobanden controle
etc

de wens is :

Wim Jansen
-------------------------
autowassen, auto aftanken, autobanden controle, etc


Wie kan mij helpen? Hartelijk dank alvast, Friend

 

[Friend]

Rapport weergave

Mocht iemand (OctaFish misschien) hier nog naar willen kijken en mij verder op weg willen helpen; heel graag. Thank you so much!

 

[OctaFish]

Daarvoor moet een recordset worden aangemaakt in VBA, die de gegevens aan elkaar knoopt in een loopje.
En vervolgens alles wegschrijft in een tijdelijke tabel. Althans: dat bedenk ik me nu.
Zal er vanavond nog eens over nadenken. En misschien heeft iemand anders wel een ander idee...

 

[OctaFish]

Ik heb wel een oplossing voor je, die werkt:

Om te beginnen: maak een tabel aan om de regels op te slaan. In mijn voorbeeld heb ik een tabel tblTemp gemaakt, met een tekstveld en een memoveld. Verder heb ik in mijn voorbeeld een query gemaakt: qProjecten. In deze query staat Groeperen aan op het veld Naam, en Projectnaam om er voor te zorgen dat alle waarden eenmaal voorkomen. Dat hoeft overigens niet, als je andere waarden wilt groeperen. Zorg er wel voor, dat je sorteert op in ieder geval het Hoofdveld, in mijn geval dus Naam. Want je wilt maar één record voor elke groep.

Op een formulier heb ik een knop gemaakt: cmdTest.
Deze heeft bijgaande code:

Private Sub cmdTest_Click()
Dim sNaam As String
Dim sWaarden As String
Dim strSQL As String

    With CurrentDb.OpenRecordset("SELECT * FROM qProjecten")
        .MoveFirst
        sNaam = .Fields("Naam").Value
        Do While Not .EOF
            If .Fields("Naam").Value = sNaam Then
                sWaarden = sWaarden & .Fields("ProjectNaam").Value & ";"
            Else
                Do Until Right(sWaarden, 1) <> ";"
                    sWaarden = Left(sWaarden, Len(sWaarden) - 1)
                Loop
                strSQL = "INSERT INTO tblTemp Values(" & Chr(34) & sNaam & Chr(34) & "," & Chr(34) & sWaarden & Chr(34) & ")"
                DoCmd.RunSQL strSQL
                sWaarden = ""
                sNaam = .Fields("Naam").Value
            End If
            .MoveNext
        Loop
    End With
    
End Sub

Als je de procedure uitvoert, wordt voor elk item een apart record gemaakt. Deze tabel kun je verder gebruiken voor je rapport.

 

[Friend]

Beste OctaFish, hartelijk dank voor je antwoord ga ik morgen gelijk uitproberen. Dit in tegenspraak met mijn motto, maar ja .....

 

[OctaFish]

Wacht nog even met uitproberen, want hier is een kleine aangepaste versie:

Private Sub cmdTest_Click()
Dim sNaam As String, sNaam_Vorig As String
Dim sProject As String, sProject_Vorig As String
Dim sWaarden As String
Dim strSQL As String
Dim i As Integer
Dim iRec As Integer
iRec = 0
sNaam = ""
sProject = ""
sNaam_Vorig = ""
sProject_Vorig = ""

    With CurrentDb.OpenRecordset("SELECT * FROM [tblProjecten] ORDER BY Naam")
        .MoveFirst
        sNaam = .Fields("Naam").Value
        Do While Not .EOF
            iRec = iRec + 1
            sNaam = .Fields("Naam").Value
            sProject = .Fields("ProjectNaam").Value
            If sNaam = sNaam_Vorig Then
                sWaarden = sWaarden & sProject & ";"
            Else
                If i = 1 And sNaam_Vorig <> sNaam Then
                    strSQL = "INSERT INTO tblTemp Values(" & Chr(34) & sNaam_Vorig & Chr(34) & "," & Chr(34) & sProject_Vorig & Chr(34) & ")"
                    DoCmd.RunSQL strSQL
                    sWaarden = ""
                    sWaarden = sWaarden & sProject & ";"
                ElseIf i = 0 Then
                    sWaarden = sWaarden & sProject & ";"
                Else
                    Do Until Right(sWaarden, 1) <> ";"
                        sWaarden = Left(sWaarden, Len(sWaarden) - 1)
                    Loop
                    strSQL = "INSERT INTO tblTemp Values(" & Chr(34) & sNaam_Vorig & Chr(34) & "," & Chr(34) & sWaarden & Chr(34) & ")"
                    DoCmd.RunSQL strSQL
                    sWaarden = ""
                    sWaarden = sWaarden & sProject & ";"
                End If
                i = 0
            End If
            i = i + 1
            sNaam_Vorig = sNaam
            sProject_Vorig = sProject
            .MoveNext
        Loop
        Do Until Right(sWaarden, 1) <> ";"
            sWaarden = Left(sWaarden, Len(sWaarden) - 1)
        Loop
        strSQL = "INSERT INTO tblTemp Values(" & Chr(34) & sNaam & Chr(34) & "," & Chr(34) & sWaarden & Chr(34) & ")"
        DoCmd.RunSQL strSQL
    End With

End Sub

Ik kwam er namelijk nog achter, dat er een klein probleem was met regels waar maar één resultaat was. De vorige code zette dan alleen de naam in de tabel, en geen waarde. Deze nieuwe routine is dus wat ingewikkelder, maar voegt wel netjes alle gegevens toe als er maar één record is. En dat lijkt mij toch wel de bedoeling...

 

[Friend]

Octafish,
Ik heb de tbltemp aangemaakt met de velden : naam (tekst) en taak (memoveld). Daarnaast de q : gProjecten. Ik neem aan dat ik die moet baseren op mijn eigen tabellen (adressen en taken) met de velden : naam en taak. Tevens heb ik een formulier gemaakt met jouw vba code onder de opdrachtknop. ik zit er mee te stoeien maar ik kom er niet uit. Is het mogelijk om jouw voorbeeld database te plaatsen, dat maakt het denk ik wat meer inzichtelijk voor mij. Of als ik het beter moet uitleggen dan hoor ik het ook graag van je. Hartelijk dank voor al je moeite!

 

[OctaFish]

Het kostte even wat moeite, want ik had de code uitgetest op een tabel met een paar duizend records. Daar leek hij goed te werken. Niet dus... Zo zie je maar dat een kleine tabel nog zo z'n voordelen heeft ook....
Hierbij een voorbeeldje dat in ieder geval wel goed werkt!

 

[Friend]

Hartelijk dank ! Ik moet zeggen het is een genot om te zien dat het werkt. Maar ja daarvoor is de een specialist en de ander niet. Hij vraagt wel bij elk record of ik het wil toevoegen. Ik moet dus meerdere keren op ok drukken. Is dit ook aan te passen ? Dat alles in een keer wordt toegevoegd. De tijdelijke tabel zou ik graag na het printen van een rapport weer willen leeg maken. Is daar ook een formule onder een opdracht knop voor mogelijk. Anders wordt de tabel met dubbele records gevoed. ? Wat mij ook opviel is dat je niet meer gebruik maakt van de query qProjecten.

 

[OctaFish]

Je hebt waarschijnlijk bij <Extra> <Opties> tabblad <Bewerken/Zoeken> een vinkje staan bij <Actiequery uitvoeren>. Als je dat uit zet, krijg je geen vragen meer. Mag je nog blij zijn dat ik niet de versie met 24000 records heb gepost

 

[Friend]

Ja klopt helemaal. Vinkje uitgezet. Heeft dit nog nadelige gevolgen in andere bewerkingen? Had je toevallig nog een mooie oplossing voor het leegmaken van de temptabel?? Bijzondere dank!

 

[OctaFish]

Tuurlijk!
Komt ie: voeg onder het declareren de volgende regels toe:

sProject_Vorig = ""

[B]strSQL = "DELETE tblProjecten.* FROM tblTemp"
On Error Resume Next
DoCmd.RunSQL strSQL
On Error GoTo 0[/B]

Ik heb overigens nu een tabel gebruikt i.p.v. een query, omdat ik in de nieuwe db een tabel nodig had met een paar records. Dus daarom gebruik ik nu een tabel. Functioneel maakt het niks uit of je een tabel of query gebruikt. Mag je zelf weten!
Zelf heb ik alle vinkjes die je bij de Opties ziet staan uitgezet; mij irriteren ze alleen maar. En veel kwaad doet het niet, als je tenminste niet per ongeluk op een Verwijderquery drukt, en dan uiteraard ook niet wordt gewaarschuwd...
Je kunt de waarschuwingen ook in de code zetten:
DoCmd.SetWarnings False
Als je dat vóór de code zet voor een DoCmd.RunSQL commando, en daaronder:
DoCmd.SetWarnings True
dan heb je het probleem ook getackled, dan werk je a.h.w. om de db instellingen heen.

 

[ReneDirks]

Even een opmerking voor Octafish, ik had vroeger ook vaak van dit soort oplossingen:

 sWaarden = sWaarden & sProject & ";"

en dan op het einde:

sWaarden = Left(sWaarden, Len(sWaarden) - 1)

Maar ik vond die laatste regel niet zo mooi. De lengte bepalen, één eraf trekken, dan weer daar het linker gedeelte van nemen.
Ik doe het nu altijd zo:

 sWaarden = sWaarden ";" & sProject

en dan op het einde:

sWaarden = mid(sWaarden, 2)

Zelfde idee, minder code

 

[OctaFish]

@René: Zal het eens bekijken! Ik gebruik ook vaak een matrix, die ik dan op het eind weer samenvoeg tot één string. De variant met de Loop werkt in ieder geval prima, ook als je om wat voor reden twee of meer ;; achter elkaar krijgt.

 

[Friend]

Octafish, bedankt voor je oplossingen! Ga het nu verder op mijn database inpassen. Zullen ze weer blij zijn met de mooie lijsten:thumb:

 

[mariasteen]

Hoe de code in module zetten en in makro opnemen

Octafish, ik ben heel erg geholpen met de "samenvoegen velden.rar"
Ik er een vraag over.
Voor en na deze gebeurtenisprocedure die in de knop staat doe ik wat andere handelingen.
Ik ben gewend om de verschillende stappen in een makro te zetten.
Dus ik dacht als ik nu de vba code in een module zet, dan kan ik het in 1 van de makro stappen opnemen.
De code kan ik wel in een module zetten, maar met de optie "procedureuitvoeren" in de makro kom ik tot niets. ik kan de module niet kiezen.
Kunt u misschien helpen?

 

[OctaFish]

Heb je de code in een functie in een aparte module gezet?
Overigens: het is niet de bedoeling om in een oude, afgeronde topic van iemand anders een andere vraag te stellen. Maak de volgende keer een eigen vraag aan, waarin je dan verwijst naar deze topic.

 

[huijb]

Deze topic is dusdanig gedateert dat deze met rust gelaten mag worden. Topic gaat op slot en wordt overgedragen aan de afdeling BNw(Betere Naslagwerken)