Imprimir Listbox
Enviado: 12 Mar 2022 às 13:40
Estou com um listbox onde preciso jogar as informações para outra aba da planilha, e dai montar o relatório, estou com esse código, porem quando mando imprimir, o formulário de inicio que é o Menu, fica na frente, e não deixa eu imprimir.
segue o código abaixo:
Private Sub BtnImprimir_Click()
Sheets("Relatorio").Select
'testa se a list esta vazia
If ListBoxConcluidos.ListCount = 0 Then
MsgBox ("Não há itens a serem impressos..."), vbInformation, ("Erro")
Else
'limpa dados antes de lançar os novos dados
If Range("A2").Select = "" Then
'não faz nanda
Else
'apaga o intervalo
Range("A2").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents
Range("A2").Select
End If
'lança os dados na planilha
Dim Item As Double
Dim Linha As Integer
'Dim valor_unitario As Double
'Dim valor_total As Double
Linha = 2
For Item = 0 To ListBoxConcluidos.ListCount - 1
If ListBoxConcluidos.Selected(Item) = True Then
'valor_unitario = ListBoxConcluidos.List(Item, 3)
'valor_total = ListBoxConcluidos.List(Item, 4)
Sheets("Relatorio").Cells(Linha, 1) = ListBoxConcluidos.List(Item, 0) 'codigo 'A
Sheets("Relatorio").Cells(Linha, 5) = ListBoxConcluidos.List(Item, 1) 'descrição 'E
Sheets("Relatorio").Cells(Linha, 2) = ListBoxConcluidos.List(Item, 2) 'data "B
Sheets("Relatorio").Cells(Linha, 11) = ListBoxConcluidos.List(Item, 3) 'datafechamento 'prioridade 'D
Sheets("Relatorio").Cells(Linha, 6) = ListBoxConcluidos.List(Item, 4) 'patrimonio 'F
Sheets("Relatorio").Cells(Linha, 7) = ListBoxConcluidos.List(Item, 5) 'solicitante 'G
Sheets("Relatorio").Cells(Linha, 8) = ListBoxConcluidos.List(Item, 6) 'secretaria "H
Sheets("Relatorio").Cells(Linha, 12) = ListBoxConcluidos.List(Item, 7) 'tecnico "L
Sheets("Relatorio").Cells(Linha, 10) = ListBoxConcluidos.List(Item, 8) 'status " 'J
Sheets("Relatorio").Cells(Linha, 14) = ListBoxConcluidos.List(Item, 9) 'parecer tecnico 'N
'Sheets("Relatorio").Cells(linha, 4) = valor_unitario
'Sheets("Relatorio").Cells(linha, 5) = valor_total
ActiveWorkbook.Save
Unload Me
Sheets("Imprimir").Select
ActiveSheet.PrintPreview
'Application.Dialogs(xlDialogPrinterSetup).Show
'ActiveWorkbook.Save
'Sheets("Imprimir").PrintOut
'Application.Dialogs(xlDialogPrintPreview).Show
'ActiveWorkbook.Save
Linha = Linha + 1
End If
Next
End If
End Sub
segue o código abaixo:
Private Sub BtnImprimir_Click()
Sheets("Relatorio").Select
'testa se a list esta vazia
If ListBoxConcluidos.ListCount = 0 Then
MsgBox ("Não há itens a serem impressos..."), vbInformation, ("Erro")
Else
'limpa dados antes de lançar os novos dados
If Range("A2").Select = "" Then
'não faz nanda
Else
'apaga o intervalo
Range("A2").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents
Range("A2").Select
End If
'lança os dados na planilha
Dim Item As Double
Dim Linha As Integer
'Dim valor_unitario As Double
'Dim valor_total As Double
Linha = 2
For Item = 0 To ListBoxConcluidos.ListCount - 1
If ListBoxConcluidos.Selected(Item) = True Then
'valor_unitario = ListBoxConcluidos.List(Item, 3)
'valor_total = ListBoxConcluidos.List(Item, 4)
Sheets("Relatorio").Cells(Linha, 1) = ListBoxConcluidos.List(Item, 0) 'codigo 'A
Sheets("Relatorio").Cells(Linha, 5) = ListBoxConcluidos.List(Item, 1) 'descrição 'E
Sheets("Relatorio").Cells(Linha, 2) = ListBoxConcluidos.List(Item, 2) 'data "B
Sheets("Relatorio").Cells(Linha, 11) = ListBoxConcluidos.List(Item, 3) 'datafechamento 'prioridade 'D
Sheets("Relatorio").Cells(Linha, 6) = ListBoxConcluidos.List(Item, 4) 'patrimonio 'F
Sheets("Relatorio").Cells(Linha, 7) = ListBoxConcluidos.List(Item, 5) 'solicitante 'G
Sheets("Relatorio").Cells(Linha, 8) = ListBoxConcluidos.List(Item, 6) 'secretaria "H
Sheets("Relatorio").Cells(Linha, 12) = ListBoxConcluidos.List(Item, 7) 'tecnico "L
Sheets("Relatorio").Cells(Linha, 10) = ListBoxConcluidos.List(Item, 8) 'status " 'J
Sheets("Relatorio").Cells(Linha, 14) = ListBoxConcluidos.List(Item, 9) 'parecer tecnico 'N
'Sheets("Relatorio").Cells(linha, 4) = valor_unitario
'Sheets("Relatorio").Cells(linha, 5) = valor_total
ActiveWorkbook.Save
Unload Me
Sheets("Imprimir").Select
ActiveSheet.PrintPreview
'Application.Dialogs(xlDialogPrinterSetup).Show
'ActiveWorkbook.Save
'Sheets("Imprimir").PrintOut
'Application.Dialogs(xlDialogPrintPreview).Show
'ActiveWorkbook.Save
Linha = Linha + 1
End If
Next
End If
End Sub