I have a form with multiple parameters. When a parameter is chosen the results are displayed in a subform at the bottom of the form.
Now I need to have a button that takes the recordsource of the subform and opens a print view of a report.
How can I send this recordsource to the report when I click the print preview button?
Below is my form code....
Thanks in advance for your help!!!!
deb
Option Compare Database 'Use database order for string comparisons
Option Explicit
Private Function IncludeFY() As String
'-- Create the Categories Where portion of the SQL statement
Dim varFY As Variant
Dim strTempFY As String
'-- for each of the items in the ItemsSelected collection
For Each varFY In Me!lboFYToInclude.ItemsSelected()
strTempFY = strTempFY & "[FY] = '" & _
Me!lboFYToInclude.ItemData(varFY) & "' or "
Next
If Len(strTempFY) > 0 Then
IncludeFY = "(" & Left$(strTempFY, Len(strTempFY) - 4) & ")"
Else
IncludeFY = ""
End If
End Function
Private Function IncludeCC() As String
'-- Create the Categories Where portion of the SQL statement
Dim varCC As Variant
Dim strTempCC As String
'-- for each of the items in the ItemsSelected collection
For Each varCC In Me!lboCCToInclude.ItemsSelected()
strTempCC = strTempCC & "[CC] = '" & _
Me!lboCCToInclude.ItemData(varCC) & "' or "
Next
If Len(strTempCC) > 0 Then
IncludeCC = "(" & Left$(strTempCC, Len(strTempCC) - 4) & ")"
Else
IncludeCC = ""
End If
End Function
Private Function IncludeG1BeltName() As String
'-- Create the Categories Where portion of the SQL statement
Dim varG1BeltName As Variant
Dim strTempG1BeltName As String
'-- for each of the items in the ItemsSelected collection
For Each varG1BeltName In Me!lboG1BeltNameToInclude.ItemsSelected()
strTempG1BeltName = strTempG1BeltName & "[G1BeltName] = '" & _
Me!lboG1BeltNameToInclude.ItemData(varG1BeltName) & "' or "
Next
If Len(strTempG1BeltName) > 0 Then
IncludeG1BeltName = "(" & Left$(strTempG1BeltName, Len(strTempG1BeltName) - 4) & ")"
Else
IncludeG1BeltName = ""
End If
End Function
Private Function IncludeChargeNo() As String
'-- Create the Categories Where portion of the SQL statement
Dim varChargeNo As Variant
Dim strTempChargeNo As String
'-- for each of the items in the ItemsSelected collection
For Each varChargeNo In Me!lboChargeNoToInclude.ItemsSelected()
strTempChargeNo = strTempChargeNo & "[ChargeNo] = '" & _
Me!lboChargeNoToInclude.ItemData(varChargeNo) & "' or "
Next
If Len(strTempChargeNo) > 0 Then
IncludeChargeNo = "(" & Left$(strTempChargeNo, Len(strTempChargeNo) - 4) & ")"
Else
IncludeChargeNo = ""
End If
End Function
Private Function IncludeSigmaPlusNo() As String
'-- Create the Categories Where portion of the SQL statement
Dim varSigmaPlusNo As Variant
Dim strTempSigmaPlusNo As String
'-- for each of the items in the ItemsSelected collection
For Each varSigmaPlusNo In Me!lboSigmaPlusNoToInclude.ItemsSelected()
strTempSigmaPlusNo = strTempSigmaPlusNo & "[SigmaPlusNo] = '" & _
Me!lboSigmaPlusNoToInclude.ItemData(varSigmaPlusNo) & "' or "
Next
If Len(strTempSigmaPlusNo) > 0 Then
IncludeSigmaPlusNo = "(" & Left$(strTempSigmaPlusNo, Len(strTempSigmaPlusNo) - 4) & ")"
Else
IncludeSigmaPlusNo = ""
End If
End Function
Private Function IncludeProjectType() As String
'-- Create the Categories Where portion of the SQL statement
Dim varProjectType As Variant
Dim strTempProjectType As String
'-- for each of the items in the ItemsSelected collection
For Each varProjectType In Me!lboProjectTypeToInclude.ItemsSelected()
strTempProjectType = strTempProjectType & "[ProjectType] = '" & _
Me!lboProjectTypeToInclude.ItemData(varProjectType) & "' or "
Next
If Len(strTempProjectType) > 0 Then
IncludeProjectType = "(" & Left$(strTempProjectType, Len(strTempProjectType) - 4) & ")"
Else
IncludeProjectType = ""
End If
End Function
Private Function IncludeSigmaStatus() As String
'-- Create the Categories Where portion of the SQL statement
Dim varSigmaStatus As Variant
Dim strTempSigmaStatus As String
'-- for each of the items in the ItemsSelected collection
For Each varSigmaStatus In Me!lboSigmaStatusToInclude.ItemsSelected()
strTempSigmaStatus = strTempSigmaStatus & "[SigmaStatus] = '" & _
Me!lboSigmaStatusToInclude.ItemData(varSigmaStatus) & "' or "
Next
If Len(strTempSigmaStatus) > 0 Then
IncludeSigmaStatus = "(" & Left$(strTempSigmaStatus, Len(strTempSigmaStatus) - 4) & ")"
Else
IncludeSigmaStatus = ""
End If
End Function
Private Sub cmdClear_Click()
Dim varDummy As Variant
Dim intCurrCat As Integer
'-- Clear all the criteria
'-- First, the multi-select list box.
For intCurrCat = 0 To Me!lboFYToInclude.ListCount - 1
Me!lboFYToInclude.Selected(intCurrCat) = False
Next
For intCurrCat = 0 To Me!lboCCToInclude.ListCount - 1
Me!lboCCToInclude.Selected(intCurrCat) = False
Next
For intCurrCat = 0 To Me!lboG1BeltNameToInclude.ListCount - 1
Me!lboG1BeltNameToInclude.Selected(intCurrCat) = False
Next
For intCurrCat = 0 To Me!lboChargeNoToInclude.ListCount - 1
Me!lboChargeNoToInclude.Selected(intCurrCat) = False
Next
For intCurrCat = 0 To Me!lboSigmaPlusNoToInclude.ListCount - 1
Me!lboSigmaPlusNoToInclude.Selected(intCurrCat) = False
Next
For intCurrCat = 0 To Me!lboProjectTypeToInclude.ListCount - 1
Me!lboProjectTypeToInclude.Selected(intCurrCat) = False
Next
For intCurrCat = 0 To Me!lboSigmaStatusToInclude.ListCount - 1
Me!lboSigmaStatusToInclude.Selected(intCurrCat) = False
Next
'-- Recreate the RecordSource for the subform
varDummy = RequerySubform()
End Sub
Private Sub optAutoRequery_AfterUpdate()
Dim varDummy As Variant
If Me!optAutoRequery Then
varDummy = RequerySubform()
End If
End Sub
Public Function RequerySubform()
Dim strFYSQL As String
Dim strCCSQL As String
Dim strG1BeltNameSQL As String
Dim strChargeNoSQL As String
Dim strSigmaPlusNoSQL As String
Dim strProjectTypeSQL As String
Dim strWhereSQL As String
Dim strFullSQL As String
Dim strSigmaStatusSQL As String
'-- If AutoRequery is set to True, or the Requery button was pressed,
'-- then re-create the Where clause for the recordsource of the subform
If Me!optAutoRequery Or Screen.ActiveControl.Name = "cmdRequery" Then
'-- Store all the criteria for the Where statement
'-- into variables.
strCCSQL = IncludeCC()
strFYSQL = IncludeFY()
strG1BeltNameSQL = IncludeG1BeltName()
strChargeNoSQL = IncludeChargeNo()
strSigmaPlusNoSQL = IncludeSigmaPlusNo()
strProjectTypeSQL = IncludeProjectType()
strSigmaStatusSQL = IncludeSigmaStatus()
'-- Store the initial Where statement with whatever is from
'-- the SigmaPlusNo criteria.
strWhereSQL = "Where " & strFYSQL
'-- If a CostCenter was passed back, then add it to the Where clause.
If Len(strCCSQL) <> 0 Then
'-- If the SigmaPlusNo criteria was already added,
'-- AND it with the CostCenter criteria.
If strWhereSQL <> "Where " Then
strWhereSQL = strWhereSQL & " And "
End If
strWhereSQL = strWhereSQL & strCCSQL
End If
'-- If a CostCenter was passed back, then add it to the Where clause.
If Len(strG1BeltNameSQL) <> 0 Then
'-- If the SigmaPlusNo criteria was already added,
'-- AND it with the CostCenter criteria.
If strWhereSQL <> "Where " Then
strWhereSQL = strWhereSQL & " And "
End If
strWhereSQL = strWhereSQL & strG1BeltNameSQL
End If
'-- If a CostCenter was passed back, then add it to the Where clause.
If Len(strChargeNoSQL) <> 0 Then
'-- If the SigmaPlusNo criteria was already added,
'-- AND it with the CostCenter criteria.
If strWhereSQL <> "Where " Then
strWhereSQL = strWhereSQL & " And "
End If
strWhereSQL = strWhereSQL & strChargeNoSQL
End If
'-- If a SigmaPlusNo was passed back, then add it to the Where clause.
If Len(strSigmaPlusNoSQL) <> 0 Then
'-- If the SigmaPlusNo criteria was already added,
'-- AND it with the CostCenter criteria.
If strWhereSQL <> "Where " Then
strWhereSQL = strWhereSQL & " And "
End If
strWhereSQL = strWhereSQL & strSigmaPlusNoSQL
End If
'-- If a CostCenter was passed back, then add it to the Where clause.
If Len(strProjectTypeSQL) <> 0 Then
'-- If the SigmaPlusNo criteria was already added,
'-- AND it with the CostCenter criteria.
If strWhereSQL <> "Where " Then
strWhereSQL = strWhereSQL & " And "
End If
strWhereSQL = strWhereSQL & strProjectTypeSQL
End If
'-- If a CostCenter was passed back, then add it to the Where clause.
If Len(strSigmaStatusSQL) <> 0 Then
'-- If the SigmaPlusNo criteria was already added,
'-- AND it with the CostCenter criteria.
If strWhereSQL <> "Where " Then
strWhereSQL = strWhereSQL & " And "
End If
strWhereSQL = strWhereSQL & strSigmaStatusSQL
End If
'-- If no criteria was chosen, make it
'-- so the subform will be blank.
If strWhereSQL = "Where " Then
strWhereSQL = "Where False;"
End If
'-- Create the new SQL String and Store it to the Recordsource.
strFullSQL = "Select * From qProjects " & strWhereSQL
Me!subQueryByForm.Form.RecordSource = strFullSQL
'-- Set the requery button to black.
Me!cmdRequery.ForeColor = 0
Else
'-- Set the requery button to red.
Me!cmdRequery.ForeColor = 255
End If
End Function
Private Sub rtpbtn_Click()
On Error GoTo Err_rtpbtn_Click
Dim stDocName As String
stDocName = "rProjectsAllq"
DoCmd.OpenReport stDocName, acPreview
Exit_rtpbtn_Click:
Exit Sub
Err_rtpbtn_Click:
MsgBox Err.Description
Resume Exit_rtpbtn_Click
End Sub
Now I need to have a button that takes the recordsource of the subform and opens a print view of a report.
How can I send this recordsource to the report when I click the print preview button?
Below is my form code....
Thanks in advance for your help!!!!
deb
Option Compare Database 'Use database order for string comparisons
Option Explicit
Private Function IncludeFY() As String
'-- Create the Categories Where portion of the SQL statement
Dim varFY As Variant
Dim strTempFY As String
'-- for each of the items in the ItemsSelected collection
For Each varFY In Me!lboFYToInclude.ItemsSelected()
strTempFY = strTempFY & "[FY] = '" & _
Me!lboFYToInclude.ItemData(varFY) & "' or "
Next
If Len(strTempFY) > 0 Then
IncludeFY = "(" & Left$(strTempFY, Len(strTempFY) - 4) & ")"
Else
IncludeFY = ""
End If
End Function
Private Function IncludeCC() As String
'-- Create the Categories Where portion of the SQL statement
Dim varCC As Variant
Dim strTempCC As String
'-- for each of the items in the ItemsSelected collection
For Each varCC In Me!lboCCToInclude.ItemsSelected()
strTempCC = strTempCC & "[CC] = '" & _
Me!lboCCToInclude.ItemData(varCC) & "' or "
Next
If Len(strTempCC) > 0 Then
IncludeCC = "(" & Left$(strTempCC, Len(strTempCC) - 4) & ")"
Else
IncludeCC = ""
End If
End Function
Private Function IncludeG1BeltName() As String
'-- Create the Categories Where portion of the SQL statement
Dim varG1BeltName As Variant
Dim strTempG1BeltName As String
'-- for each of the items in the ItemsSelected collection
For Each varG1BeltName In Me!lboG1BeltNameToInclude.ItemsSelected()
strTempG1BeltName = strTempG1BeltName & "[G1BeltName] = '" & _
Me!lboG1BeltNameToInclude.ItemData(varG1BeltName) & "' or "
Next
If Len(strTempG1BeltName) > 0 Then
IncludeG1BeltName = "(" & Left$(strTempG1BeltName, Len(strTempG1BeltName) - 4) & ")"
Else
IncludeG1BeltName = ""
End If
End Function
Private Function IncludeChargeNo() As String
'-- Create the Categories Where portion of the SQL statement
Dim varChargeNo As Variant
Dim strTempChargeNo As String
'-- for each of the items in the ItemsSelected collection
For Each varChargeNo In Me!lboChargeNoToInclude.ItemsSelected()
strTempChargeNo = strTempChargeNo & "[ChargeNo] = '" & _
Me!lboChargeNoToInclude.ItemData(varChargeNo) & "' or "
Next
If Len(strTempChargeNo) > 0 Then
IncludeChargeNo = "(" & Left$(strTempChargeNo, Len(strTempChargeNo) - 4) & ")"
Else
IncludeChargeNo = ""
End If
End Function
Private Function IncludeSigmaPlusNo() As String
'-- Create the Categories Where portion of the SQL statement
Dim varSigmaPlusNo As Variant
Dim strTempSigmaPlusNo As String
'-- for each of the items in the ItemsSelected collection
For Each varSigmaPlusNo In Me!lboSigmaPlusNoToInclude.ItemsSelected()
strTempSigmaPlusNo = strTempSigmaPlusNo & "[SigmaPlusNo] = '" & _
Me!lboSigmaPlusNoToInclude.ItemData(varSigmaPlusNo) & "' or "
Next
If Len(strTempSigmaPlusNo) > 0 Then
IncludeSigmaPlusNo = "(" & Left$(strTempSigmaPlusNo, Len(strTempSigmaPlusNo) - 4) & ")"
Else
IncludeSigmaPlusNo = ""
End If
End Function
Private Function IncludeProjectType() As String
'-- Create the Categories Where portion of the SQL statement
Dim varProjectType As Variant
Dim strTempProjectType As String
'-- for each of the items in the ItemsSelected collection
For Each varProjectType In Me!lboProjectTypeToInclude.ItemsSelected()
strTempProjectType = strTempProjectType & "[ProjectType] = '" & _
Me!lboProjectTypeToInclude.ItemData(varProjectType) & "' or "
Next
If Len(strTempProjectType) > 0 Then
IncludeProjectType = "(" & Left$(strTempProjectType, Len(strTempProjectType) - 4) & ")"
Else
IncludeProjectType = ""
End If
End Function
Private Function IncludeSigmaStatus() As String
'-- Create the Categories Where portion of the SQL statement
Dim varSigmaStatus As Variant
Dim strTempSigmaStatus As String
'-- for each of the items in the ItemsSelected collection
For Each varSigmaStatus In Me!lboSigmaStatusToInclude.ItemsSelected()
strTempSigmaStatus = strTempSigmaStatus & "[SigmaStatus] = '" & _
Me!lboSigmaStatusToInclude.ItemData(varSigmaStatus) & "' or "
Next
If Len(strTempSigmaStatus) > 0 Then
IncludeSigmaStatus = "(" & Left$(strTempSigmaStatus, Len(strTempSigmaStatus) - 4) & ")"
Else
IncludeSigmaStatus = ""
End If
End Function
Private Sub cmdClear_Click()
Dim varDummy As Variant
Dim intCurrCat As Integer
'-- Clear all the criteria
'-- First, the multi-select list box.
For intCurrCat = 0 To Me!lboFYToInclude.ListCount - 1
Me!lboFYToInclude.Selected(intCurrCat) = False
Next
For intCurrCat = 0 To Me!lboCCToInclude.ListCount - 1
Me!lboCCToInclude.Selected(intCurrCat) = False
Next
For intCurrCat = 0 To Me!lboG1BeltNameToInclude.ListCount - 1
Me!lboG1BeltNameToInclude.Selected(intCurrCat) = False
Next
For intCurrCat = 0 To Me!lboChargeNoToInclude.ListCount - 1
Me!lboChargeNoToInclude.Selected(intCurrCat) = False
Next
For intCurrCat = 0 To Me!lboSigmaPlusNoToInclude.ListCount - 1
Me!lboSigmaPlusNoToInclude.Selected(intCurrCat) = False
Next
For intCurrCat = 0 To Me!lboProjectTypeToInclude.ListCount - 1
Me!lboProjectTypeToInclude.Selected(intCurrCat) = False
Next
For intCurrCat = 0 To Me!lboSigmaStatusToInclude.ListCount - 1
Me!lboSigmaStatusToInclude.Selected(intCurrCat) = False
Next
'-- Recreate the RecordSource for the subform
varDummy = RequerySubform()
End Sub
Private Sub optAutoRequery_AfterUpdate()
Dim varDummy As Variant
If Me!optAutoRequery Then
varDummy = RequerySubform()
End If
End Sub
Public Function RequerySubform()
Dim strFYSQL As String
Dim strCCSQL As String
Dim strG1BeltNameSQL As String
Dim strChargeNoSQL As String
Dim strSigmaPlusNoSQL As String
Dim strProjectTypeSQL As String
Dim strWhereSQL As String
Dim strFullSQL As String
Dim strSigmaStatusSQL As String
'-- If AutoRequery is set to True, or the Requery button was pressed,
'-- then re-create the Where clause for the recordsource of the subform
If Me!optAutoRequery Or Screen.ActiveControl.Name = "cmdRequery" Then
'-- Store all the criteria for the Where statement
'-- into variables.
strCCSQL = IncludeCC()
strFYSQL = IncludeFY()
strG1BeltNameSQL = IncludeG1BeltName()
strChargeNoSQL = IncludeChargeNo()
strSigmaPlusNoSQL = IncludeSigmaPlusNo()
strProjectTypeSQL = IncludeProjectType()
strSigmaStatusSQL = IncludeSigmaStatus()
'-- Store the initial Where statement with whatever is from
'-- the SigmaPlusNo criteria.
strWhereSQL = "Where " & strFYSQL
'-- If a CostCenter was passed back, then add it to the Where clause.
If Len(strCCSQL) <> 0 Then
'-- If the SigmaPlusNo criteria was already added,
'-- AND it with the CostCenter criteria.
If strWhereSQL <> "Where " Then
strWhereSQL = strWhereSQL & " And "
End If
strWhereSQL = strWhereSQL & strCCSQL
End If
'-- If a CostCenter was passed back, then add it to the Where clause.
If Len(strG1BeltNameSQL) <> 0 Then
'-- If the SigmaPlusNo criteria was already added,
'-- AND it with the CostCenter criteria.
If strWhereSQL <> "Where " Then
strWhereSQL = strWhereSQL & " And "
End If
strWhereSQL = strWhereSQL & strG1BeltNameSQL
End If
'-- If a CostCenter was passed back, then add it to the Where clause.
If Len(strChargeNoSQL) <> 0 Then
'-- If the SigmaPlusNo criteria was already added,
'-- AND it with the CostCenter criteria.
If strWhereSQL <> "Where " Then
strWhereSQL = strWhereSQL & " And "
End If
strWhereSQL = strWhereSQL & strChargeNoSQL
End If
'-- If a SigmaPlusNo was passed back, then add it to the Where clause.
If Len(strSigmaPlusNoSQL) <> 0 Then
'-- If the SigmaPlusNo criteria was already added,
'-- AND it with the CostCenter criteria.
If strWhereSQL <> "Where " Then
strWhereSQL = strWhereSQL & " And "
End If
strWhereSQL = strWhereSQL & strSigmaPlusNoSQL
End If
'-- If a CostCenter was passed back, then add it to the Where clause.
If Len(strProjectTypeSQL) <> 0 Then
'-- If the SigmaPlusNo criteria was already added,
'-- AND it with the CostCenter criteria.
If strWhereSQL <> "Where " Then
strWhereSQL = strWhereSQL & " And "
End If
strWhereSQL = strWhereSQL & strProjectTypeSQL
End If
'-- If a CostCenter was passed back, then add it to the Where clause.
If Len(strSigmaStatusSQL) <> 0 Then
'-- If the SigmaPlusNo criteria was already added,
'-- AND it with the CostCenter criteria.
If strWhereSQL <> "Where " Then
strWhereSQL = strWhereSQL & " And "
End If
strWhereSQL = strWhereSQL & strSigmaStatusSQL
End If
'-- If no criteria was chosen, make it
'-- so the subform will be blank.
If strWhereSQL = "Where " Then
strWhereSQL = "Where False;"
End If
'-- Create the new SQL String and Store it to the Recordsource.
strFullSQL = "Select * From qProjects " & strWhereSQL
Me!subQueryByForm.Form.RecordSource = strFullSQL
'-- Set the requery button to black.
Me!cmdRequery.ForeColor = 0
Else
'-- Set the requery button to red.
Me!cmdRequery.ForeColor = 255
End If
End Function
Private Sub rtpbtn_Click()
On Error GoTo Err_rtpbtn_Click
Dim stDocName As String
stDocName = "rProjectsAllq"
DoCmd.OpenReport stDocName, acPreview
Exit_rtpbtn_Click:
Exit Sub
Err_rtpbtn_Click:
MsgBox Err.Description
Resume Exit_rtpbtn_Click
End Sub
