como imprimir listview com vba

Question

tenho o seguinte formulário e quero imprimir o conteúdo da listview e da caixa de testo que contem o valor total

Private Sub CmdCapitarInforma_Click()
If ChbAvista.Value = "" Then
End If
   TextBox25 = TxtValordoPedido()
End Sub

Private Sub Cmd_Orssamento_Click()
ThisWorkbook.Worksheets("Produtos").Activate
    Range("B3").Select
     For cont = 1 To 100
   If ActiveCell = TxtNomedoProduto.Text Then
    ActiveCell.Offset(0, 1).Value = TxtNomedoProduto.Value
    ActiveCell.Value = TxtNomedoProduto.Value
    ActiveCell.Offset(0, 10).Value = TextQuant.Value
    End If
    ActiveCell.Offset(1, 0).Activate
   Next
       Range("B3").Select
End Sub

Private Sub Cmd_Vender_Click()
'Ativar a primeira planilha
        ThisWorkbook.Worksheets("Porcetagen").Activate
                'Selecionar a célula A3
            
              Range("B2:B2").Select
                'ProcurAr a primeira célula vazia
            Do
            If Not (IsEmpty(ActiveCell)) Then
                ActiveCell.Offset(1, 0).Select
                 ActiveCell.Offset = Empty
            End If
        Loop Until IsEmpty(ActiveCell) = True
                
               'Carregar os dados digitados nas caixas de texto para a planilha
            ActiveCell.Offset(0, 0).Value = lbltotal.Caption
            ActiveCell.Value = lbltotal.Caption
            
 ActiveWorkbook.Save
 Frm_Vendas.Show
  ListPreco.Clear
      LtQuantDescricao.Clear
      LtValorUnitario.Clear
      lbltotal = Empty
End Sub




Private Sub CmdCalcular_Click()
CmdCalcular.BackColor = &HE0E0E0
CmdCarrinho.BackColor = &HFF00&
  If TxtValorDoProduto.Text = "" Then
        MsgBox "É necessario fazer uma pesquisa e digitar a quantidade!", vbInformation, "Tela de boas vindas"
        TxtNomedoProduto.SetFocus
        Exit Sub
    End If
    
    If CDbl(TextQuant.Text) <= CDbl(TxtQuantidadeEmEStoque.Text) Then 'verificando a quantidade em estoque
        TxtValorTotalUnt.Text = Format(CDbl(TxtValorDoProduto.Text) * CDbl(TextQuant.Text), "  #,##.00") ' QUANDO FOR MOEDA )
    Else
        MsgBox "Quantidade vendida maior que a quantidade em estoque!", vbInformation, "Tela de boas vindas"
        TextQuant.SetFocus 'campo quantidade recebe o focu
        TextQuant.SelStart = 0 'defifinindo o inicio da seleção
        TextQuant.SelLength = Trim(TxtValorDoProduto.Text) 'seleciona todo o conteudo do campo eliminando espacos em branco
        Exit Sub
    End If
TxtValorTotalUnt.Text = Format(CDbl(TxtValorDoProduto.Text) * CDbl(TextQuant.Text), "  #,##.00") ' QUANDO FOR MOEDA )
   Call Destravar.carrinho
End Sub

Private Sub CmdCarrinho_Click()
Call Atualizar
Call soma
 CmdCarrinho.Visible = False
End Sub

Private Sub CmdLiberar_Click()
Call Destravar.Destravar
    If CmdLiberar.Caption = "Liberar" Then
        CmdLiberar.Caption = "Bloquear"
        
    Else
        CmdLiberar.Caption = "Liberar"
        Call Travar.Trancar
    End If
End Sub

Private Sub CmdLimpaarr_Click()
      'ListPreco.Clear
      'LtQuantDescricao.Clear
      'LtValorUnitario.Clear
      'lbltotal = Empty
End Sub
        

Private Sub CmdLimparr_Click()
    TxtVenderCpfDoCliente.Value = Empty
    TxtValordoPedido.Value = Empty
    LblTotalDoPedido.Caption = Empty
    End Sub

Private Sub CmdLiparFrmProdutos_Click()
TxtNomedoProduto = Empty
End Sub





Private Sub CmdSAIR_Click()
    Unload Me
End Sub

Private Sub CmdSomar_Click()
        Dim total As Double ''Cria uma variavel do tipo dublu
        For x = 0 To ListPreco.ListCount - 1 ''Faz um loop de 0 ate
          ''(Quantidade de inens -1
        total = total + ListPreco.List(x, 0) '' incrementa total a cadaloop
        Next
        TxtSomar = CStr(total) '' Mostra o total no label22
        
        TxtSomar.TextAlign = Format(TxtSomar.TextAlign, "#,##.00") ' QUANDO FOR MOEDA )
End Sub

Private Sub CmdPpesquizar_Click()
Txt_Cod_do_Produto.SpecialEffect = fmSpecialEffectEtched
'Verificar se foi digitado um nome na primeira caixa de texto
        If ComboBox1.Text = "" Then
                 MsgBox "Digite o Nome do produto!"
            ComboBox1.SetFocus
             Call Destravar.TextQuant
               GoTo linha1
         Else
            Call Destravar.liberar1
            
            Call Destravar.CmdLiberar
            Call Destravar.TextQuant
        End If
With Worksheets("Produtos").Range("B:B")
        Set c = .Find(ComboBox1.Value, LookIn:=xlValues, _
        LookAt:=xlPart)
    If Not c Is Nothing Then
            TxtNomedoProduto.Value = c.Value
            TxtMarcadoProduto.Value = c.Offset(0, 1).Value
            TxtReferenciadoproduto.Value = c.Offset(0, 2).Value
            TxtMarcadoCarro.Value = c.Offset(0, 3).Value
            TxtNomedoCarro.Value = c.Offset(0, 4).Value
            TxtNumerodapratileira.Value = c.Offset(0, 5).Value
            TxtNumerodaGaveta.Value = c.Offset(0, 6).Value
            TxtValorDoProduto.Value = c.Offset(0, 7).Value
            TxtQuantidadeEmEStoque.Value = c.Offset(0, 9).Value
            Txt_Cod_do_Produto.Value = c.Offset(0, 11).Value

       End If
        End With
linha1:
End Sub

Private Sub CmdSairFrmProdutos_Click()
     If MsgBox("Deseja relmente sair do sistema?", vbExclamation + vbYesNo, "Alerta") = vbYes Then
       Unload Me
       Else
      Exit Sub
    End If
End Sub
        
    
Private Sub CmdLimpar_Click()
   'Limpar as caixas de texto
       
End Sub

Private Sub CmdLimpaar_Click()
        'Limpar as caixas de texto
        TxtDPF.Value = Empty
        TextBox20.Value = Empty
        TextBox21.Value = Empty
        TxtValordoPedido.Value = Empty
        TextBox22.Value = Empty
End Sub

Private Sub Label10_Change()
    Label10 = Format(Date & "")
End Sub



Private Sub CmdTeste_Click()

'Verificar se foi digitado um nome na primeira caixa de texto
        If TxtTeste.Text = "" Then
             MsgBox "Digite o Nome do produto"
        ComboBox1.SetFocus
        GoTo linha1
        End If
 With Worksheets("Produtos").Range("A:A")
        Set c = .Find(ComboBox1.Value, LookIn:=xlValues, _
        LookAt:=xlPart)
    
    If Not c Is Nothing Then
            
           ComboBox1.Value = c.Value
            TxtTeste.Value = c.Offset(0, 1).Value
     End If
        End With
linha1:
End Sub

Private Sub TxtSomaTotal_Change()
 TxtSomaTotal = ListPreco()
End Sub



Private Sub ComboBox1_Enter()
If ComboBox1.BackColor = &H80000005 Then
ComboBox1.BackColor = &HC0FFFF
ElseIf ComboBox1.BackColor = &HC0FFFF Then
ComboBox1.BackColor = &H80000006
ComboBox1.ForeColor = &H80000005
ElseIf ComboBox1.BackColor = &H80000006 Then
ComboBox1.BackColor = &H80000005
ComboBox1.ForeColor = &H80000008
End If
With Me.ComboBox1
        .Clear    ' limpa o conteúdo do listbox
       MyUniqueList = UniqueItemList(Worksheets("Produtos").Range("B3:B30000"), True)
        For i = 1 To UBound(MyUniqueList)
            .AddItem MyUniqueList(i)
        Next i
        .ListIndex = 0    ' seleciona o primeiro item
    End With
End Sub


Private Sub ButonAtualizar_Click()
    Dim MyUniqueList As Variant, i As Long
    With Me.ListBox1
        .Clear    ' limpa o conteúdo do listbox
        
        MyUniqueList = UniqueItemList(Worksheets("Produtos").Range("A1:A30000"), True)
        For i = 1 To UBound(MyUniqueList)
            .AddItem MyUniqueList(i)
        Next i
        .ListIndex = 0    ' seleciona o primeiro item
    End With
  
     'listbox2
    With Me.ListBox2
        .Clear    ' limpa o conteúdo do listbox
        MyUniqueList = UniqueItemList(Worksheets("Produtos").Range("H1:H30000"), True)
        For i = 1 To UBound(MyUniqueList)
            .AddItem MyUniqueList(i)
        Next i
        .ListIndex = 0    ' seleciona o primeiro item
    End With
End Sub

Private Sub CmdAtualizarr_Click()
 Dim MyUniqueList As Variant, i As Long
    With Me.ListBox1
        .Clear    ' limpa o conteúdo do listbox
        
        MyUniqueList = UniqueItemList(Worksheets("Produtos").Range("B1:B30000"), True)
        For i = 1 To UBound(MyUniqueList)
            .AddItem MyUniqueList(i)
        Next i
        .ListIndex = 0    ' seleciona o primeiro item
    End With
  
     'listbox2
    With Me.ListBox2
        .Clear    ' limpa o conteúdo do listbox
        MyUniqueList = UniqueItemList(Worksheets("Produtos").Range("I1:I30000"), True)
        For i = 1 To UBound(MyUniqueList)
            .AddItem MyUniqueList(i)
        Next i
        .ListIndex = 0    ' seleciona o primeiro item
        
        
    End With
End Sub



Private Sub CommandButton13_Click()
   If vsFlexArray1.Value = selecte Then
   FixedRows = ""
   End If
End Sub


Private Sub CommandButton14_Click()
Frm_Cancelar_Item.Show
End Sub

Private Sub Label31_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
   If TxtValordoPedido = "" Then
   TxtValordoPedido = 0
   Else
   Label31 = TxtValordoPedido.Text + TxtAcresimo.Text
   End If
   Label31 = Format(Label31, "#,##.00") ' QUANDO FOR MOEDA )
End Sub

Private Sub TextBox23_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
If ComboBox1 = "" Then
Exit Sub
Else
TextBox23 = ComboBox1
End If
End Sub




Private Sub TxtAcresimo_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
TxtAcresimo.Text = "200%"
TxtAcresimo.Locked = True
End Sub

Private Sub TxtDesconto_Change()
TxtDesconto.Text = Format(TxtDesconto.Text, "#,##.00") ' QUANDO FOR MOEDA )
TxtDesconto.Text = "5%"
End Sub

Private Sub TextBox21_Change()
TextBox21.Text = Format(TextBox21.Text, "#,##.00") ' QUANDO FOR MOEDA )
End Sub

Private Sub TextBox22_Change()
TextBox22.Text = Format(TextBox22.Text, "#,##.00") ' QUANDO FOR MOEDA )
End Sub






Private Sub FrameCADASTRODePRODUTOS_Click()

End Sub

Private Sub CommandButton21_Click()
'Verificar se foi digitado um nome na primeira caixa de texto
        If ComboBox2.Text = "" Then
                 MsgBox "Digite o Nome do produto!"
            ComboBox2.SetFocus
             Call Destravar.TextQuant
               GoTo linha1
         Else
            Call Destravar.liberar1
            
            Call Destravar.CmdLiberar
            Call Destravar.TextQuant
        End If
With Worksheets("Produtos").Range("B:B")
        Set c = .Find(ComboBox1.Value, LookIn:=xlValues, _
        LookAt:=xlPart)
    If Not c Is Nothing Then
            TxtNomedoProduto.Value = c.Value
            TxtMarcadoProduto.Value = c.Offset(0, 1).Value
            TxtReferenciadoproduto.Value = c.Offset(0, 2).Value
            TxtMarcadoCarro.Value = c.Offset(0, 3).Value
            TxtNomedoCarro.Value = c.Offset(0, 4).Value
            TxtNumerodapratileira.Value = c.Offset(0, 5).Value
            TxtNumerodaGaveta.Value = c.Offset(0, 6).Value
            TxtValorDoProduto.Value = c.Offset(0, 7).Value
            TxtQuantidadeEmEStoque.Value = c.Offset(0, 9).Value
            Txt_Cod_do_Produto.Value = c.Offset(0, 11).Value

       End If
        End With
linha1:

End Sub

Private Sub TextBox8_Change()
TextBox8.Text = Format(TextBox8.Text, "#,##.00") ' QUANDO FOR MOEDA )
End Sub

Private Sub CommandButton15_Click()
Call Pesquizar
End Sub


Private Sub CommandButton17_Click()
ListView1.SelectedItem = ""
ListView1.SelectedItem.SubItems(1) = ""
 ListView1.SelectedItem.SubItems(2) = ""
 ListView1.SelectedItem.SubItems(3) = ""
 ListView1.SelectedItem.SubItems(4) = ""
 ListView1.SelectedItem.SubItems(5) = ""
 ListView1.SelectedItem.SubItems(6) = ""
 ListView1.SelectedItem.SubItems(7) = ""
 ListView1.SelectedItem.SubItems(8) = ""
 ListView1.SelectedItem.SubItems(9) = ""
 ListView1.ControlTipText = 0
 
End Sub

Private Sub Frame1_Click()

End Sub



Private Sub TextQuant_Enter()
Call Destravar.CmdCalcular
CmdCalcular.BackColor = &HC0FF00
End Sub

Private Sub TxtValordoPedido_Change()
TxtValordoPedido.Text = Format(TxtValordoPedido.Text, "#,##.00") ' QUANDO FOR MOEDA )
End Sub

Private Sub TxtValorDoProduto_Change()
TxtValorDoProduto.Text = Format(TxtValorDoProduto.Text, "#,##.00") ' QUANDO FOR MOEDA )
End Sub
'ppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppp
Private Sub Pesquizar()
        If Txt_Cod_do_Produto = "" Then
                 MsgBox "Digite o Nome do produto!"
            Txt_Cod_do_Produto.SetFocus
             Call Destravar.TextQuant
               GoTo linha1
         Else
            Call Destravar.liberar1
            Call Destravar.CmdLiberar
            Call Destravar.TextQuant
        End If
With Worksheets("Produtos").Range("A:A")
        Set c = .Find(Txt_Cod_do_Produto.Value, LookIn:=xlValues, _
        LookAt:=xlPart)
    If Not c Is Nothing Then
            'TxtNomedoProduto.Value = c.Value
            TxtNomedoProduto.Value = c.Offset(0, 1).Value
            TxtMarcadoProduto.Value = c.Offset(0, 2).Value
            TxtReferenciadoproduto.Value = c.Offset(0, 3).Value
            TxtMarcadoCarro.Value = c.Offset(0, 4).Value
            TxtNomedoCarro.Value = c.Offset(0, 5).Value
            TxtNumerodapratileira.Value = c.Offset(0, 6).Value
            TxtNumerodaGaveta.Value = c.Offset(0, 7).Value
            TxtValorDoProduto.Value = c.Offset(0, 8).Value
            TxtQuantidadeEmEStoque.Value = c.Offset(0, 10).Value
            Txt_Cod_do_Produto.Value = c.Offset(0, 12).Value

       End If
       End With
linha1:
'ppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppp
End Sub

Private Sub UserForm_Activate()
 Call ListView
Call Travar.Trancar
ComboBox1 = "Clique aqui para pesquisar"
Label10 = Format(Now, "Long Date") & " - " & Right(Now(), 8)


    End Sub
'ilicializa ListView1

Private Sub ListView()

With ListView1
.Gridlines = True
.View = lvwReport
.FullRowSelect = True

.ColumnHeaders.Add Index:=1, Text:="COD", Width:=30
.ColumnHeaders.Add Index:=2, Text:="Nome", Width:=100
.ColumnHeaders.Add Index:=3, Text:="Marca", Width:=55
.ColumnHeaders.Add Index:=4, Text:="REF", Width:=50
.ColumnHeaders.Add Index:=5, Text:="Mar do Carro", Width:=50
.ColumnHeaders.Add Index:=6, Text:="Nome do Carro", Width:=50
.ColumnHeaders.Add Index:=7, Text:="Nº da pratileira", Width:=50
.ColumnHeaders.Add Index:=8, Text:="Nº da gaveta", Width:=50
.ColumnHeaders.Add Index:=9, Text:="Valor do Untario", Width:=100
.ColumnHeaders.Add Index:=10, Text:="Q_Em estoque", Width:=70
.ColumnHeaders.Add Index:=11, Text:="Valor total", Width:=70

End With
End Sub

Sub Atualizar()
Dim Item As ListItem
Dim linhafinal As Integer
Dim i As Integer

'ListView1.ListItems.Clear
'LinhaFinal = 1 'Plan1.Cells(Rows.Count, 1).End(xlUp).Row

For i = 1 To 1
 Set Item = ListView1.ListItems.Add(Text:=Txt_Cod_do_Produto.Text)   '(Text:=Plan1.Cells(i, 1))
  Item.SubItems(1) = TxtNomedoProduto.Text
  Item.SubItems(2) = TxtMarcadoProduto.Text
  Item.SubItems(3) = TxtReferenciadoproduto.Text 'Plan1.Cells(i, 4)
  Item.SubItems(4) = TxtMarcadoCarro.Text 'Plan1.Cells(i, 4) - (DateValue(Now))
  Item.SubItems(5) = TxtNomedoCarro.Text 'Plan1.Cells(i, 5)
  Item.SubItems(6) = TxtNumerodapratileira.Text 'Plan1.Cells(i, 5)
  Item.SubItems(7) = TxtNumerodaGaveta.Text 'Plan1.Cells(i, 5)
  Item.SubItems(8) = TxtValorDoProduto 'Plan1.Cells(i, 5)
  Item.SubItems(9) = TxtQuantidadeEmEStoque.Text 'Plan1.Cells(i, 5)
  Item.SubItems(10) = TxtValorTotalUnt.Text 'Plan1.Cells(i, 5)
Next
  'finaliza ListView1
End Sub
Sub soma()
    Dim i As Integer
       
       i = TxtValorTotalUnt
    If Txt_total.Text = "" Then
       Txt_total = TxtValorTotalUnt
    ElseIf Txt_total.Text = Txt_total.Text Then
       Txt_total.Text = Txt_total.Text + i / 1
     End If
         Txt_total.Text = Format(Txt_total.Text, "#,##.00")

End Sub
 
Private Function UniqueItemList(InputRange As Range, _
     HorizontalList As Boolean) As Variant
      Dim cl As Range, cUnique As New Collection, i As Long, uList() As Variant
        Application.Volatile
      On Error Resume Next
      For Each cl In InputRange
            If cl.Formula <> "" Then
                cUnique.Add cl.Value, CStr(cl.Value)
            End If
        Next cl
        UniqueItemList = ""
        If cUnique.Count > 0 Then
            ReDim uList(1 To cUnique.Count)
            For i = 1 To cUnique.Count
                uList(i) = cUnique(i)
            Next i
            UniqueItemList = uList
            If Not HorizontalList Then
                UniqueItemList = _
                Application.WorksheetFunction.Transpose(UniqueItemList)
            End If
        End If
        On Error GoTo 0
   
End Function
'Fecha listbox


Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
  If CloseMode = vbFrmLogin - ControlMenu Then
Cancel = True
MsgBox "Deseja relmente sair do sistema? Cliqui em sair", vbCritical, "Erro"
End If
End Sub

Answer 1

tenho o seguite formulario e quero imprimi o conteudo da listview e da daixa de texto que contem o valor 80,00 desde ja muito obrigado a que poder me ajudar!