imprimir listbox filtrado

[barraus]

Bom dia. Tentei utilizar o código acima e não funcionou. Então tentei de outra forma, mas funcionou apenas parcialmente:

- Uso o formFiltro (editado) para filtrar numa lista de pessoas apenas os aniversariantes do mês e para imprimir a lista uso o seguinte código:

Private Sub CommandButton2_Click()
Plan19.Activate 'ativa a planilha 19 onde quero que os dados da listbox sejam copiados
Range("A1").Resize(ListBoxLista.ListCount) = ListBoxLista.List 'Copia os valores da ListBoxLista para a célula A1
Application.ScreenUpdating = False
Sheets("list_box").Visible = True 'exibe a Plan19 que aqui renomeei de "list_box"
Sheets("list_box").Select
ActiveWindow.SelectedSheets.PrintOut Copies:=1 'Imprime 1 cópia do conteúdo da Plan19
[A1:D1048576].ClearContents ' limpa todo o conteúdo da planilha
Sheets("list_box").Visible = xlSheetVeryHidden 'oculta novamente a planilha
Application.ScreenUpdating = True
End Sub

Esse procedimento copia os dados da ListBox e cola na célula A1 da Plan19 e imprime o conteúdo- o problema é que só copia e cola 1 coluna e no meu caso, meu ListBox possui 4 colunas. Alguma dica?

Grato.

[barraus]

Bom dia. Tentei utilizar o código acima e não funcionou. Então tentei de outra forma, mas funcionou apenas parcialmente:

- Uso o formFiltro (editado) para filtrar numa lista de pessoas apenas os aniversariantes do mês e para imprimir a lista uso o seguinte código:

Private Sub CommandButton2_Click()
Plan19.Activate 'ativa a planilha 19 onde quero que os dados da listbox sejam copiados
Range("A1").Resize(ListBoxLista.ListCount) = ListBoxLista.List 'Copia os valores da ListBoxLista para a célula A1
Application.ScreenUpdating = False
Sheets("list_box").Visible = True 'exibe a Plan19 que aqui renomeei de "list_box"
Sheets("list_box").Select
ActiveWindow.SelectedSheets.PrintOut Copies:=1 'Imprime 1 cópia do conteúdo da Plan19
[A1:D1048576].ClearContents ' limpa todo o conteúdo da planilha
Sheets("list_box").Visible = xlSheetVeryHidden 'oculta novamente a planilha
Application.ScreenUpdating = True
End Sub

Esse procedimento copia os dados da ListBox e cola na célula A1 da Plan19 e imprime o conteúdo- o problema é que só copia e cola 1 coluna e no meu caso, meu ListBox possui 4 colunas. Alguma dica?

Grato.

Opa! Já resolvi! - Ficou assim:

Private Sub CommandButton5_Click()

Plan19.Activate 'ativa a planilha 19 onde quero copiar os dados

Dim oCol As Integer
Dim Lista As Integer
Dim nextRow As Integer
Dim lCount As Integer

oCol = 1
Lista = 0

PreenchePedidos:
With Sheets("list_box") 'seleciona a planilha e insere os dados
nextRow = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0).Row
End With
With Me.ListBoxLista
For lCount = 0 To .ColumnCount
Sheets("list_box").Cells(nextRow, oCol) = .List(Lista, lCount)
oCol = oCol + 1

Next

If .ListCount - 1 > Lista Then
oCol = 1
Lista = Lista + 1
GoTo PreenchePedidos
Else

Plan19.Activate
Application.ScreenUpdating = False
Sheets("list_box").Visible = True 'exibe a Plan19 que aqui renomeei de "list_box"
Plan19.Activate ' Chama a "Plan19 - list_box
Columns("A:A").ColumnWidth = 38.86 ' determina a largura da coluna A
Plan19.Activate ' Chama a "Plan19 - list_box
Columns("B:B").ColumnWidth = 20.01 ' determina a largura da coluna B
Plan19.Activate ' Chama a "Plan19 - list_box
Columns("C:C").ColumnWidth = 7.01 ' determina a largura da coluna C
Plan19.Activate ' Chama a "Plan19 - list_box
Columns("D:D").ColumnWidth = 10.01 ' determina a largura da coluna D
Sheets("list_box").Select
ActiveWindow.SelectedSheets.PrintOut Copies:=1 'Imprime 1 cópia do conteúdo da Plan19
[A1:D1048576].ClearContents ' limpa todo o conteúdo da planilha
Sheets("list_box").Visible = xlSheetVeryHidden 'oculta novamente a planilha
Application.ScreenUpdating = True

ListBoxLista.clear 'limpa o conteúdo do ListBox

Exit Sub

End If

End With

End Sub

Com um clique no botão "IMPRIMIR PESQUISA" todo o conteúdo da ListBox é copiado para uma planilha, impresso e ainda faz a limpeza da planilha, oculta-a e limpa o ListBox.

Bom, não?

[AndersonDorneles]

Fabio,

Você quer imprimir o resultado do listbox? Se for isso, imprimir formulários é uma tarefa quase impossível, já que temos problemas com barras de rolagem e tudo mais. Porque não transferimos o conteúdo do ListBox para uma planilha vazia e a imprimimos?

Peguei esse código em outro fórum. Não testei, mas o que pretendemos e pode ser um bom começo:

Código: Selecionar todos

Sub TransferFromListbox()
'Dump contents of selected items into a worksheet
    Dim lngListLoop As Long
    Dim lngRowNum As Long, lngColNum As Long
    
    

    'The row and column numbers here determine the
    'starting cell of where the data will be added.
    'Change to suit your needs.
    
    lngRowNum = 1
    lngColNum = 1
    

    With Me.ListBox1

        For lngListLoop = 0 To .ListCount - 1
            
            If .Selected(lngListLoop) = True Then
                
                Sheets("Sheet1").Cells(lngRowNum, lngColNum) = .List(lngListLoop, 0)
                Sheets("Sheet1").Cells(lngRowNum, lngColNum + 1) = .List(lngListLoop, 1)
                Sheets("Sheet1").Cells(lngRowNum, lngColNum + 2) = .List(lngListLoop, 2)
                
                lngRowNum = lngRowNum + 1
                
            End If
            
        Next

    End With

End Sub

Abraços

Olá Boa tarde,

Estou querendo fazer a mesma coisa que o companheiro acima. Peguei o codigo e tentei insetir no meu e simplesmente foi sem efeito, nem msg de erro deu.

Meu código é este, filtra os dados que preciso, mostra corretamente no ListBox, porem preciso passar esses dados para uma planilha modelo e depois salvar em PDF.

Código: Selecionar todos

Private Sub Listar_Relatorios_Nao_Autorizadas_Click()

On Error GoTo TrataErro

Dim ws As Worksheet
Dim Compara_Valor As String
Dim Compara As String
Dim lastRow As Long
Dim i As Integer

Dim lngListLoop As Long
Dim lngRowNum As Long, lngColNum As Long

Set ws = ThisWorkbook.Worksheets("Registros")

ListBox_Relatorios.Clear
ListBox_Relatorios.ListStyle = fmListStyleOption  'Escolher opções
ListBox_Relatorios.ColumnHeads = True
ListBox_Relatorios.ColumnWidths = "40pt;60pt;150pt;90pt;90pt;90pt;90pt;90pt;150pt;90pt"

With ws
       
    lngRowNum = 1
    lngColNum = 1
       
       
lastRow = Sheets("Registros").Range("A1:M1500").End(xlDown).Row
Compara = "Aguardando"
            
  '------------------- função exportar ListBox --------------------------------------------------------------------------------'          
    With Me.ListBox_Relatorios

        For lngListLoop = 0 To .ListCount - 1
            
            If .Selected(lngListLoop) = True Then
                
                Sheets("Modelo_Relatorio").Cells(lngRowNum, lngColNum) = .List(lngListLoop, 0)
                Sheets("Modelo_Relatorio").Cells(lngRowNum, lngColNum + 1) = .List(lngListLoop, 1)
                Sheets("Modelo_Relatorio").Cells(lngRowNum, lngColNum + 2) = .List(lngListLoop, 2)
                
                lngRowNum = lngRowNum + 1
                
            End If
            
        Next

    End With
            
            'Call TransferFromListbox ' tentei por como call e não funcionou
   '---------------------------------------------------------------------------------------------------------------------------------'
            'adiciona cabeçalho
            '--------------------------------------------------------------------------------------------------------------------'
                Me.ListBox_Relatorios.AddItem Sheets("Registros").Range("B" & 1)
                Me.ListBox_Relatorios.List(Me.ListBox_Relatorios.ListCount - 1, 1) = Sheets("Registros").Range("D" & 1)
                Me.ListBox_Relatorios.List(Me.ListBox_Relatorios.ListCount - 1, 2) = Sheets("Registros").Range("E" & 1)
                Me.ListBox_Relatorios.List(Me.ListBox_Relatorios.ListCount - 1, 3) = Sheets("Registros").Range("H" & 1)
                Me.ListBox_Relatorios.List(Me.ListBox_Relatorios.ListCount - 1, 4) = Sheets("Registros").Range("I" & 1)
                Me.ListBox_Relatorios.List(Me.ListBox_Relatorios.ListCount - 1, 5) = Sheets("Registros").Range("J" & 1)
                Me.ListBox_Relatorios.List(Me.ListBox_Relatorios.ListCount - 1, 6) = Sheets("Registros").Range("K" & 1)
                Me.ListBox_Relatorios.List(Me.ListBox_Relatorios.ListCount - 1, 7) = Sheets("Registros").Range("L" & 1)
                Me.ListBox_Relatorios.List(Me.ListBox_Relatorios.ListCount - 1, 8) = Sheets("Registros").Range("M" & 1)
                Me.ListBox_Relatorios.List(Me.ListBox_Relatorios.ListCount - 1, 9) = Sheets("Registros").Range("N" & 1)
            '--------------------------------------------------------------------------------------------------------------------'
          
       For i = 1 To lastRow
           Compara_Valor = .Cells(i + 1, 14).Value
          If Compara_Valor = Compara Then
                        Compara_Valor = .Cells(i + 1, 14).Value
                        'MsgBox "Valores" & Compara_Valor

                'adiciona dados
             '--------------------------------------------------------------------------------------------------------------------'
                Me.ListBox_Relatorios.AddItem Sheets("Registros").Range("B" & i + 1)
                Me.ListBox_Relatorios.List(Me.ListBox_Relatorios.ListCount - 1, 1) = Sheets("Registros").Range("D" & i + 1)
                Me.ListBox_Relatorios.List(Me.ListBox_Relatorios.ListCount - 1, 2) = Sheets("Registros").Range("E" & i + 1)
                Me.ListBox_Relatorios.List(Me.ListBox_Relatorios.ListCount - 1, 3) = Sheets("Registros").Range("H" & i + 1)
                Me.ListBox_Relatorios.List(Me.ListBox_Relatorios.ListCount - 1, 4) = Sheets("Registros").Range("I" & i + 1)
                Me.ListBox_Relatorios.List(Me.ListBox_Relatorios.ListCount - 1, 5) = Sheets("Registros").Range("J" & i + 1)
                Me.ListBox_Relatorios.List(Me.ListBox_Relatorios.ListCount - 1, 6) = Sheets("Registros").Range("K" & i + 1)
                Me.ListBox_Relatorios.List(Me.ListBox_Relatorios.ListCount - 1, 7) = Sheets("Registros").Range("L" & i + 1)
                Me.ListBox_Relatorios.List(Me.ListBox_Relatorios.ListCount - 1, 8) = Sheets("Registros").Range("M" & i + 1)
                Me.ListBox_Relatorios.List(Me.ListBox_Relatorios.ListCount - 1, 9) = Sheets("Registros").Range("N" & i + 1)
             '--------------------------------------------------------------------------------------------------------------------'
                      

                      
          End If
       Next i

    'atualiza o label de mensagens
    If ListBox_Relatorios.ListCount <= 0 Then
        Label_Relatorio.Caption = ListBox_Relatorios.ListCount & " registros encontrados"
    Else
        Label_Relatorio.Caption = ListBox_Relatorios.ListCount - 1 & " registros encontrados"
    End If
       
End With
    
Exit Sub
   
TrataErro:
   MsgBox "Erro " & Err.Description, vbCritical, "Erro"

A sua ideia de exportar os dados pra uma planilha modelo e depois imprimir (Salvar em PDF) eu ja estou fazendo isso com outros dados e ja tenho a função pronta. Se eu conseguir passar os valores do ListBox para uma outra planilha, termino o meu projeto.

Desde já agradeço!

Anderson Dorneles

[tiagorocha]

jovemlima,

taí a planilha montada depois da ajuda de Tomaz!!

ficou assim.. depois que pesquisa que aparece os dados no listbox, clica em "Transferir" depois em "Imprimir".

Tem como me enviar por e-mail a planilha ? estou baixando aqui, mas está como arquivo corrompido. por favor. E-mail: tiago_rocha17@hotmail.com