MaximoAccess

Caro Usuário, antes de postar pela primeira vez, leia as regras do fórum.

Obrigado

Administração do MaximoAccess

Dicas Ms Access, Exemplos Ms Access, Codigos VBA Ms Access, SQL Ms Access

    imprimir relatório com lista após filtrada

    Compartilhe

    jos_port
    Novato
    Novato

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 7
    Registrado : 03/07/2014

    imprimir relatório com lista após filtrada

    Mensagem  jos_port em Sab 02 Maio 2015, 17:31

    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
    avatar
    tauron
    Super Avançado
    Super Avançado

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 697
    Registrado : 07/12/2011

    Re: imprimir relatório com lista após filtrada

    Mensagem  tauron em Sab 02 Maio 2015, 18:19

    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

    andrecc
    Novato
    Novato

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 41
    Registrado : 10/08/2012

    Re: imprimir relatório com lista após filtrada

    Mensagem  andrecc em Sab 02 Maio 2015, 18:28

    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


    jos_port
    Novato
    Novato

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 7
    Registrado : 03/07/2014

    imprimir relatório com lista após filtrada

    Mensagem  jos_port em Dom 03 Maio 2015, 01:32

    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

    jos_port
    Novato
    Novato

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 7
    Registrado : 03/07/2014

    imprimir relatório com lista após filtrada

    Mensagem  jos_port em Dom 03 Maio 2015, 13:03

    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.
    avatar
    jeanrocha
    Novato
    Novato

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 26
    Registrado : 13/08/2013

    Re: imprimir relatório com lista após filtrada

    Mensagem  jeanrocha em Qui 28 Set 2017, 12:27

    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.
    avatar
    tauron
    Super Avançado
    Super Avançado

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 697
    Registrado : 07/12/2011

    Re: imprimir relatório com lista após filtrada

    Mensagem  tauron em Sex 29 Set 2017, 20:29

    Retornando aos poucos para evitar novos imprevistos.
    Anexos
    Marcarnalista.zip
    Você não tem permissão para fazer download dos arquivos anexados.
    (54 Kb) Baixado 5 vez(es)

      Data/hora atual: Ter 21 Nov 2017, 17:39