leban pdf convertr and criteria ?

[rob.low]

Hi All,
I've been useing the Leban report to pdf code and it works great.

My problem is that some of my reports have no filtering from querys.
they are filterd by the following code behind a command button
that selects, selected records from a list box

Private Sub Command73_Click()
Dim blRet As Boolean
Dim strWhere As String
Dim ctl As Control
Dim varItem As Variant

On Error GoTo Command73_Click_Error
'make sure a selection has been made
If Me.lstCustInfo.ItemsSelected.Count = 0 Then
MsgBox "Must select at least 1 record"
Exit Sub
End If
'add selected values to string
Set ctl = Me.lstCustInfo
For Each varItem In ctl.ItemsSelected
strWhere = strWhere & ctl.ItemData(varItem) & ","
Next varItem
'trim trailing comma
strWhere = Left(strWhere, Len(strWhere) - 1)
'open the report, restricted to the selected items
DoCmd.OpenReport "clients", acPreview, , "clientid IN(" & strWhere & ")"

On Error GoTo 0
Exit Sub
Command73_Click_Error:
MsgBox "Too Meny Results to Report, Please Adjust your Search. ", vbExclamation, "Too Meny Results"
End Sub

this is the lebans code (slightly modified to my needs) which calls the report and converts it to pdf

blRet = ConvertReportToPDF("singlerecord", vbNullString, _
("Clint Record") & ".pdf", False, True, 150, "", "", 0, 0, 0)

I have been trying to work out how to convert the code to work with the lebans pdf code

all help, info and hints wellcomed

thanks
rob

 

[SOS]

Does your report have a saved query as its record source? If so you could use a QueryDef to modify it before the other code is called.

 

[rob.low]

Hi yes The report uses A saved Query As it sorce (clientsquery1)

How would i go about useing a querydef ? could you explain.
thanks very much for your help.
Rob

 

[SOS]

I would use Access MVP Armen Stein's ReplaceWhereClause code (available here free) and then use it like this:

Private Sub Command73_Click()
    Dim blRet As Boolean
    Dim strWhere As String
    Dim ctl As Control
    Dim varItem As Variant
[B][COLOR=red]   Dim db As DAO.Database[/COLOR][/B]
[B][COLOR=red]   Dim qdf As DAO.QueryDef[/COLOR][/B]
 
    On Error GoTo Command73_Click_Error
    'make sure a selection has been made
    If Me.lstCustInfo.ItemsSelected.Count = 0 Then
        MsgBox "Must select at least 1 record"
        Exit Sub
    End If
    'add selected values to string
    Set ctl = Me.lstCustInfo
    For Each varItem In ctl.ItemsSelected
        strWhere = strWhere & ctl.ItemData(varItem) & ","
    Next varItem
    'trim trailing comma
    strWhere = Left(strWhere, Len(strWhere) - 1)
 
[B][COLOR=red]   Set db = CurrentDb[/COLOR][/B]
[B][COLOR=red]   Set qdf = db.QueryDefs("clientsquery1")[/COLOR][/B]
 
[B][COLOR=red]   qdf.SQL = ReplaceWhereClause(qdf.SQL, strWhere)[/COLOR][/B]
 
    'open the report, restricted to the selected items
    DoCmd.OpenReport "clients", acPreview
 
    [B][COLOR=red]qdf.Close[/COLOR][/B]
[B][COLOR=red]   Set qdf = Nothing[/COLOR][/B]
 
    On Error GoTo 0
    Exit Sub
Command73_Click_Error:
    MsgBox "Too Meny Results to Report, Please Adjust your Search. ", vbExclamation, "Too Meny Results"
End Sub

 

[rob.low]

Hi i get a error when i call this code ?

private Sub Command160_Click()
Dim blRet As Boolean
Dim strWhere As String
Dim ctl As Control
Dim varItem As Variant
Dim db As DAO.Database
Dim qdf As DAO.QueryDef

On Error GoTo Command160_Click_Error
'make sure a selection has been made
If Me.lstCustInfo.ItemsSelected.Count = 0 Then
MsgBox "Must select at least 1 record"
Exit Sub
End If
'add selected values to string
Set ctl = Me.lstCustInfo
For Each varItem In ctl.ItemsSelected
strWhere = strWhere & ctl.ItemData(varItem) & ","
Next varItem
'trim trailing comma
strWhere = Left(strWhere, Len(strWhere) - 1)

Set db = CurrentDb
Set qdf = db.QueryDefs("clients query1")

qdf.SQL = ReplaceWhereClause(qdf.SQL, strWhere)

'open the report, restricted to the selected items
DoCmd.OpenReport "clients", acPreview

qdf.Close
Set qdf = Nothing

On Error GoTo 0
Exit Sub
Command160_Click_Error:
MsgBox "Too Meny Results to Report, Please Adjust your Search. ", vbExclamation, "Too Meny Results"
End Sub

this is the error

---------------------------
Microsoft Visual Basic
---------------------------
Compile error:
Sub or Function not defined
---------------------------

thanks for your help
rob

 

[SOS]

Hi i get a error when i call this code ?

Yes, you would get that unless you went to the link I provided, downloaded the file and then put the appropriate module into your database.

 

[SOS]

See this part and download from the link:

I would use Access MVP Armen Stein's ReplaceWhereClause code (available here free)

 

[rob.low]

Hi ,
Thanks for all your help with this.

The Way i got it to work is with the following code.
It opens the repot then converts to pdf with lebans code then closes the report

I put this code into a moudle then called it when i need it.

Public Function stpdf()
Dim blRet As Boolean
Dim strWhere As String
Dim ctl As Control
Dim varItem As Variant
'make sure a selection has been made

'Forms!clients!Command50.Enabled = False

On Error GoTo stpdf_Error
If Forms!tstfrm.lstCustInfo.ItemsSelected.Count = 0 Then
MsgBox "Please Select The records For The Report", vbExclamation, "Please Select Records"
Exit Function
End If
'add selected values to string
Set ctl = Forms!tstfrm.lstCustInfo
For Each varItem In ctl.ItemsSelected
strWhere = strWhere & ctl.ItemData(varItem) & ","
Next varItem
'trim trailing comma
strWhere = Left(strWhere, Len(strWhere) - 1)
'open the report, restricted to the selected items
DoCmd.OpenReport "clients", acPreview, , "clientid IN(" & strWhere & ")"
'MsgBox "Report Was Created Successfully", vbInformation, "Report Created Successfully"

blRet = ConvertReportToPDF("clients", vbNullString, _
("Clint Record") & ".pdf", False, True, 150, "", "", 0, 0, 0)
DoCmd.Close acReport, "clients"

On Error GoTo 0
Exit Function
stpdf_Error:
MsgBox "To Meny Records Please Narrow Down Your search", vbExclamation, "To Meny Records"
End Function

then call the module

call stpdf()

thanks again for looking and helping..... I am learning a lot from this Forum

Rob