Rapport --> PDF en datumselectie

Status
Niet open voor verdere reacties.

iegje

Gebruiker
Lid geworden
25 apr 2007
Berichten
125
Met behulp van dit forum ben ik al een heel eind gekomen met mijn rapportage.
Ik heb een formulier gemaakt met datumselectie voor het rapport (Met dank aan Octafish). Via een preview wordt het rapport getoond van een gekozen startdatum tot een einddatum.
Verder een rapport wat bevat wat ik erin wil hebben.

Ook lukt het me om het rapport naar PDF te converteren met behulp van de LeBan methode. Alleen ontbreekt dan de datumselectie van het formulier. Is het ook mogelijk dit hierin in te voegen en en zo ja hoe doe ik dit?
 
iemand een idee??
Zelf herb ik al vanalles geprobeerd, maar ik kom er niet uit. :confused:
 
Tuurlijk.... alleen staat de oplossing thuis, en niet op 't werk. Je zult even tot vanavond moeten wachten...
 
Hij is even over het hoofd heen geschoten :o
Ik zal 'm vanavond posten.
 
Met deze code onder de PDF knop moet je een heel eind komen...

Code:
Private Sub cmdReportToPDF_Click()

Dim blRet As Boolean
Dim lngView As Long
Dim sFilter As String, strReport As String
Dim strWhere As String
Const strcJetDate = "\#mm\/dd\/yyyy\#"  'Do NOT change it to match your local settings.
   
    'Variabelen instellen.
    strReport = "rppMaand"                      'Put your report name in these quotes.
    strDateField = "[qryOverzicht].[Datum]"     'Put your field name in the square brackets in these quotes.

    'Filter string opbouwen....
    If IsDate(Me.txtStartDate) Then
        strWhere = " WHERE (" & strDateField & " >= " & Format(Me.txtStartDate, strcJetDate) & ")"
    End If
    If IsDate(Me.txtEndDate) Then
        If strWhere <> vbNullString Then
            strWhere = strWhere & " AND "
        End If
        strWhere = strWhere & "(" & strDateField & " < " & Format(Me.txtEndDate + 1, strcJetDate) & ")"
    End If
    
    'Vervolgens filter op het rapport vastleggen....
    DoCmd.OpenReport sRapport, acViewDesign, , , acHidden
    sTabel = Reports(sRapport).RecordSource
    If InStr(1, UCase(sTabel), "WHERE") > 0 Then
        strSQL = Left(sTabel, InStr(1, sTabel, "WHERE ") - 1)
    Else
        If InStr(1, UCase(sTabel), "SELECT") = 0 Then
            If InStr(1, sTabel, " ") > 0 And InStr(1, sTabel, "[") = 0 Then
                sTabel = "[" & sTabel & "]"
            End If
            strSQL = "SELECT * FROM " & sTabel & " "
        Else
            strSQL = sTabel
        End If
    End If

    'Extra loopje, om de punt-komma's te verwijderen.
    Do Until Right(strSQL, 1) <> ";"
        strSQL = Left(strSQL, Len(strSQL) - 1)
    Loop

    strSQL = strSQL & " " & strWhere
    ''tmp = InputBox("", "", strSQL)
    Reports(sRapport).RecordSource = strSQL
    DoCmd.Close acReport, sRapport, acSaveYes

    DoCmd.Minimize
    DoCmd.OpenReport stDocName, acPreview, , sFilter

    'Call our convert function
    blRet = ConvertReportToPDF(Me.lstRptName, vbNullString, Me.lstRptName.Value & ".pdf", False, True, 150, "", "", 0, 0, 0)
 
End Sub
 
Ik krijg de vraag dat de rapportnaam opgegeven moet worden.
De foutopsporing geeft gelijk de 1e regel van onderstaande code op als fout :(

Code:
 'Vervolgens filter op het rapport vastleggen....
    [COLOR="red"]DoCmd.OpenReport sRapport, acViewDesign, , , acHidden[/COLOR]   
 sTabel = Reports(sRapport).RecordSource[/COLOR] 
    If InStr(1, UCase(sTabel), "WHERE") > 0 Then
        strSQL = Left(sTabel, InStr(1, sTabel, "WHERE ") - 1)
    Else
        If InStr(1, UCase(sTabel), "SELECT") = 0 Then
            If InStr(1, sTabel, " ") > 0 And InStr(1, sTabel, "[") = 0 Then
                sTabel = "[" & sTabel & "]"
            End If
            strSQL = "SELECT * FROM " & sTabel & " "
        Else
            strSQL = sTabel
        End If
    End If
 
Dat kan kloppen; ik heb de rapportnaam in een variabele sRapport gestoken. Dat moet je dan of aanpassen, of ook toepassen.
Dim sRapport as String
sRapport="Rapportnaam"
 
Die is gelukt :D

Alleen krijg ik nu dezelfde melding voor het laaste stukje code.
Rapportnaam opgeven.

Als ik dit toevoeg, krijg ik daar ook een foutmelding over.
Code:
Dim sRapport as String
sRapport="Rapportnaam"

Code:
    [COLOR="red"]DoCmd.OpenReport stDocName, acPreview, , sFilter[/COLOR]
    'Call our convert function
    blRet = ConvertReportToPDF(Me.lstRptName, vbNullString, Me.lstRptName.Value & ".pdf", False, True, 150, "", "", 0, 0, 0)
 
End Sub
 
Dat is ook weer een variabele. Als het over dezelfde rapportnaam gaat, en dat is volgens mij zo, vervang je stDocName door sRapport, en je bent er! Dat krijg je ervan als je code niet test ;)
 
Zo komen we er ook wel. :D

Super bedankt Octafish, je bent een held.
Zo is het precies zoals ik wil dat het wordt.
 
Helaas, op de testschijf doet hij het perfect nu in de definitieve versie krijg ik de volgende melding: Sub of Function is niet gedefinieerd

Code:
'Call our convert function
    blRet = ConvertReportToPDF(Me.lstRptName, vbNullString, Me.lstRptName.Value & ".pdf", False, True, 150, "", "", 0, 0, 0)
 
Waarschijnlijk moet je de juiste module nog importeren in de produktie db. Aan het formulier alleen heb je niet genoeg... Rechtsklikken in de groep Modules, <Importeren>, en dan de testdb openen.
 
Oh ja, beetje dom dat ik dat vergeten ben :o

Alles werkt super
 
Kan-ie denk ik op opgelost?
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan