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
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