imprimir relatório com lista após filtrada

Bom dia,

Tenho um form com listbox onde posso imprimir um relatório com apenas o item selecionados em dois cliques, ou imprimir a listagem completa.
Gostaria de imprimir somente os itens filtrados, já tentei modificar o código diversa vezes mas sempre imprime a relação completa.
Alguém pode me ajudar? qual seria a melhor forma de resolver?
Segue abaixo o código do form.

Desde já agradeço,

"
Option Compare Database
Dim j As Byte
Dim filtroLista As String



Private Sub btImprimir_Click()
On Error GoTo trataerro
DoCmd.OpenReport "Rlt_Tempo_estoque", acViewPreview, OpenArgs:="Select * From Cs_ItensDataentrada Where" & filtro
DoCmd.Maximize
sair:
Exit Sub
trataerro:
If Err.Number = 2501 Then
MsgBox "Não há lista resultante para impressão...", vbInformation, "Aviso"
End If
Resume sair
End Sub

Private Sub btRemover_Click()
'----------------------------------------
'Carrga a listbox com todos os registros
'-----------------------------------------
Call fncCarregalista("Codigo > 0")
'-----------------------------------------
'Limpa as caixas de texto de filtragens
'------------------------------------------
For j = 1 To 4
Me("tx" & j) = Null
Next
Me!tx1.SetFocus
End Sub



Private Sub Form_Open(Cancel As Integer)
'----------------------------------------
'Carrga a listbox com todos os registros
'-----------------------------------------
Call fncCarregalista("Codigo > 0")
End Sub

Private Sub Lista_DblClick(Cancel As Integer)
If IsNull(Me!Lista.Column(0)) Then Exit Sub
DoCmd.OpenReport "Rlt_Tempo_estoque", acViewPreview, , "Codigo =" & Me!Lista.Column(0)
DoCmd.Maximize
End Sub

Private Sub Lista_LostFocus()
'----------------------
'Desmarca a listBox
'----------------------
Me!Lista.Value = -1
End Sub

Private Sub tx1_Change()
Call fncFiltrar(Me!tx1.Name)
End Sub
Private Sub tx2_Change()
Call fncFiltrar(Me!tx2.Name)
End Sub
Private Sub tx3_Change()
Call fncFiltrar(Me!tx3.Name)
End Sub
Private Sub tx4_Change()
Call fncFiltrar(Me!tx4.Name)
End Sub

Public Sub fncFiltrar(NomeCampoFoco As String)
Dim x As String, filtro As String, strSplit As String
Dim f(4) As String, cp(4) As Variant
Dim k As Variant, p As Byte
Dim booPos As Boolean

'------------------------------------------------------------------
' Variável x recebe o valor digitado na caixa de texto de filtragem
'-------------------------------------------------------------------
x = Me(NomeCampoFoco).Text: p = 0

'--------------------------------------------------------------------------------------
'Passa para a matrix Cp() todos os valores digitados nas caixas de texto de filtragens
'--------------------------------------------------------------------------------------
For p = 0 To 3
cp(p) = IIf(InStr(NomeCampoFoco, "tx" & p + 1) > 0, x, Me("tx" & p + 1))
Next

'----------------------------------------------------------------------------------------------------------------------------
' Passa para a matrix f() os campos a serem filtrados, com os respectivos valores digitados nas caixas de texto de filtragens
'-----------------------------------------------------------------------------------------------------------------------------
f(0) = "DataEntrada Like '*" & cp(0) & "*'"
f(1) = IIf(cp(1) = Chr(32), "OS is null", "OS Like '*" & cp(1) & "*'")
f(2) = IIf(cp(2) = Chr(32), "PNEntrada is null", "PNEntrada Like '*" & cp(2) & "*'")
f(3) = "Box Like '*" & cp(3) & "*'"

'------------------------------------------------------------------------------------------
'Passa para Variável strSplit o comprimento de texto da cada caixa de texto de filtragens
'Comprimento zero(0) significa que a caixa de texto de filtragem se encontra vazia
'Exemplo: strSplit = 2|0|1|0
'Significa que os campos 2 e 4 não receberam valores para serem filtrados
'------------------------------------------------------------------------------------------
strSplit = Len(cp(0) & "") & "|" & Len(cp(1) & "") & "|" & Len(cp(2) & "") & "|" & Len(cp(3) & "")
k = Split(strSplit, "|")

'----------------------------------------------------------------------------------------------
'Filtro assume todos os valores de registros caso todos os campos de filtragens estejam limpos
'----------------------------------------------------------------------------------------------
filtro = "Codigo > 0": p = 0

'------------------------------------------------------------------------------------------
'Monta a variável filtro com todos os campos de filtragens que possuirem valores digitados
'------------------------------------------------------------------------------------------
For p = 0 To UBound(k)
If Val(k(p)) > 0 Then
If booPos = False Then
filtro = f(p): booPos = True
Else
filtro = filtro & " AND " & f(p)
End If
End If
Next p

'--------------------------------------------
'Carrga a listbox com os registros filtrados
'--------------------------------------------
Call fncCarregalista(filtro)


End Sub

Private Sub fncCarregalista(Optional filtro As String, Optional ordem As String)
Dim strSql As String
strSql = "SELECT Codigo, DataEntrada, OS, PNEntrada, Box, Descricao, Revisao"
strSql = strSql & " FROM Cs_ItensDataentrada WHERE " & filtro
strSql = strSql & " ORDER BY DataEntrada;"
Me!Lista.RowSource = strSql
filtroLista = filtro
End Sub

Tente assim:
Na listbox (nao acopladada):

Private Sub sualista_AfterUpdate()
   Me!suaLista = Proper(Me!suaLista)
End Sub

no botao para chamar o relatorio:

Private Sub seubotao_Click()
 
   Dim sel As Variant
   Dim strwhere As String
   
   strwhere = "item in ("
   For Each sel In Me.suaLista.ItemsSelected
       strwhere = strwhere & "'" & Me.sualista.ItemData(sel) & "',"
   Next
   strwhere = strwhere & ")"
   
   DoCmd.OpenReport "seurelatorio", acViewPreview, , strwhere
End Sub

Se você postasse o BD ficaria mais fácil (tentar) ajudar, mas se você criasse mais um botão com o código abaixo, não funciona?

Private Sub btImprimirXX_Click()
On Error GoTo trataerro
DoCmd.OpenReport "Rlt_Tempo_estoque", acViewPreview, OpenArgs:=Me!Lista.RowSource
DoCmd.Maximize
sair:
Exit Sub
trataerro:
If Err.Number = 2501 Then
MsgBox "Não há lista resultante para impressão...", vbInformation, "Aviso"
End If
Resume sair
End Sub

Boa noite,

Obrigado pela ajuda mas já tentei da duas formas e não funciona.
tauron, no código que me enviou ele dá erro " Erro em tempo de execução '3075':
Erro de Sintaxe (operador faltando) na expressão de consulta '(Item in 0'. "
Pede para depurar e aparece esta linha em amarelo
"DoCmd.OpenReport "Rlt_Tempo_Custo_estoque", acViewPreview, , strwhere"

andrecc
Já havia tentado desta forma, ele apresenta toda a lista (368 paginas),

Vou tentar minimizar o BD, mandar as tabelas e consultas utilizadas para o arquivo ficar menor, e aí envio um zip.

Obrigado pela ajuda

Bom dia,

Desculpe mas meu arquivo é grande demais, já exclui tudo o que podia para manter o form e relatório funcionando, assim vocês poderiam avaliar, mas não vai , excede o tamanho de arquivo permitido.

Vou continuar tentando, se encontrar a resposta eu retorno.

Eu tive o mesmo problema e resolvi referenciando a consulta do relatório nas caixas de combinação do formulário que também servem para filtrar a caixa de listagem. Eu estava procurando um jeito de fazer com maior facilidade pois em cada item a ser filtrado precisa fazer a referência individualmente sendo assim quando vc abrir o relatório vai filtrar segundo seu form que é utilizado para filtrar a caixa de listagem. O inconveniente desta forma é que precisa ter o formulário aberto para reaplicar as filtragens.

Retornando aos poucos para evitar novos imprevistos.