Jump to content
Antonio Augusto Crovador

Imprimir dados da listview

Recommended Posts

Antonio Augusto Crovador

boa tarde amigos, estou tentando imprimir mais não estou tendo exito, alguem pode ajudar-me ?

 

Function Imprimir()
    If lv.ListItems.Count = 0 Then
        MsgBox "Não há dados para ser impresso.", vbInformation, "AVISO"
    Else
        Dim i%, LVWidth%, NewTab%, j%
Dim itmX As ListItem
Dim ContaLinha%
 
  LVWidth = 0
  For i = 1 To lv.ColumnHeaders.Count
     LVWidth = LVWidth + lv.ColumnHeaders(i).Width
  Next
  NewTab = 0
   'imprime o cabeçalho
  For i = 1 To lv.ColumnHeaders.Count
      NewTab = NewTab + CInt(lv.ColumnHeaders(i).Width * Printer.ScaleWidth / LVWidth)
      Printer.Print lv.ColumnHeaders(i).Text;
      Printer.CurrentX = NewTab
  Next
  'imprime uma linha de separação
  Printer.Print
  'imprime_linha
  Printer.Print
  'se o numero de linhas do ListView for maior que o de linhas a
  'a imprimir então imprime o conteúdo total de Listview
  If Lines < lv.ListItems.Count And Lines <> 0 Then
       ContaLinha = Lines
   Else
       ContaLinha = lv.ListItems.Count
   End If
  'imprime os itens e subitens
  For i = 1 To ContaLinha
       NewTab = 0
       Set itmX = lv.ListItems(i)
       Printer.Print itmX.Text;
       For j = 1 To lv.ColumnHeaders.Count - 1
             NewTab = NewTab + CInt(lv.ColumnHeaders(j).Width * Printer.ScaleWidth / LVWidth)
             Printer.CurrentX = NewTab
             Printer.Print itmX.SubItems(j);
       Next
       Printer.Print
  Next
  'envia os dados para impressora
  Printer.EndDoc
        MsgBox "Dados impresso com sucesso.", vbInformation, "Aviso"
    End If
End Function

 

Share this post


Link to post
Share on other sites
Rhysand

Bom dia,

Eu para imprimir de uma ListView, passo os dados da ListView para uma folha Excel e depois imprimo a folha Excel

Deixo aqui um exemplo com partes do meu código, tente adaptar as suas necessidades:

Private Sub CommandButton1_Click()

With Application.ThisWorkbook.Worksheets("Files")
    .Visible = xlSheetVisible '  só se necessário (pode remover esta parte)
    .Unprotect "My Password"  '  só se necessário (pode remover esta parte)
    .Select
    On Error Resume Next
    .Cells.Delete
End With

Dim k As Long, i As Long, J As Long

With Me.ListView2 ' Copiar dados da ListView para Folha Excel (com os cabeçalhos da ListView)  '   Exemplo a inicar na linha 5 (cabeçalhos)
   For k = 1 To .ColumnHeaders.Count
       Application.ThisWorkbook.Worksheets("Files").Cells(5, k) = .ColumnHeaders.Item(k).Text
       Application.ThisWorkbook.Worksheets("Files").Cells(5, k).Font.Bold = True
       Application.ThisWorkbook.Worksheets("Files").Cells(5, k).Font.Size = 12
       Application.ThisWorkbook.Worksheets("Files").Cells(5, k).Interior.Color = &HE0E0E0 ' cinza claro
   Next
   For i = 1 To .ListItems.Count + 1
       Application.ThisWorkbook.Worksheets("Files").Cells(7 + i, 1) = .ListItems(i - 1).Text  '   Exemplo a inicar na linha 7 (ListView Itens & SubItens) (linha 6 é de separação de dados...)
       For J = 1 To .ListItems(i - 1).ListSubItems.Count
           Application.ThisWorkbook.Worksheets("Files").Cells(7 + i, J + 1) = .ListItems(i - 1).SubItems(J)
       Next
   Next
End With



Call Imprimir ' imprimir os dados da folha de Excel ... ALTERAR A PRIMEIRA E ÚLTIMA COLUNA ( eu coloquei neste exemplo A:E)

End Sub









Private Sub Imprimir()

Dim myWorksheet As Worksheet
Dim iCounter As Long
Dim myCmPointsBase As Single ' define várias margens e tamanhos de imagem caso se coloque alguma
Dim LastRow As Long

Set myWorksheet = Application.ThisWorkbook.Worksheets("Files")
'Set myWorksheet = ActiveSheet

LastRow = myWorksheet.Cells(myWorksheet.Rows.Count, "A").End(xlUp).Row ' determinar ultima linha com dados

myCmPointsBase = Application.CentimetersToPoints(0.5) ' método Application.CentimeterToPoints converte 0,5 centímetros em pontos (calcular margens)

With myWorksheet
    .ResetAllPageBreaks ' reset para redefinir a seguir todas as quebras de página
    For iCounter = LastRow To 1 Step 50 ' adiciona uma quebra de página a cada 50 linhas desde linha 1 até ultima linha definida (lastrow)
        .HPageBreaks.Add .Cells(iCounter, 1)
    Next iCounter
        With .PageSetup
            .PrintArea = "A1:E" & LastRow ' área de impressão ( SELECIONAR A PRIMEIRA E ÚLTIMA COLUNA)
            .PaperSize = xlPaperA4 '  tamanho do papel
            .Orientation = xlPortrait '  orientação
            .Zoom = False '  (1/3)False... para que sheet seja dimensionada de acordo com as propriedades FitToPagesTall e FitToPagesWide
            .FitToPagesTall = False '  (2/3)False... permite que o dimensionamento seja determinado por uma única propriedade: FitToPagesWide
            .FitToPagesWide = 1 '   (3/3)Dimensiona sheet para 1 página de largura
            .PrintGridlines = False ' true (imprime as bordas das cells) // false (não imprime)
            .PrintHeadings = False '    true (os títulos das linhas e colunas são impressos) // false (não imprime)
            .PrintTitleRows = myWorksheet.Rows(5).Address ' (linha 13)especifica que uma linha é repetida como linha de cabeçalho na parte superior de cada página impressa
'            .PrintQuality = -3 ' ******ATENÇÃO****** - depende de cada PC e Impressora
            .FooterMargin = myCmPointsBase * 2 ' margem do rodapé
            .HeaderMargin = myCmPointsBase * 2 ' margem do cabeçalho
            .AlignMarginsHeaderFooter = True ' true (Alinha cabeçalhos e rodapés com as margens direita e esquerda) // false (não alinha)
            .TopMargin = myCmPointsBase * 5 '  margem superior
            .RightMargin = myCmPointsBase * 3 ' margem direita
            .BottomMargin = myCmPointsBase * 5 '  margem inferior
            .LeftMargin = myCmPointsBase * 3 ' margem esquerda
            .CenterHorizontally = True ' centralizar sheet na horizontal
            .CenterVertically = False ' centralizar sheet na vertical
            .CenterFooter = "&IImpresso por computador" ' define o rodapé central para exibir texto "Impresso por computador". Usa o código de formatação & B para ativar/desativar a impressão em negrito
            .RightFooter = "Página &P de &N" ' define o rodapé direito para exibir o número da página a partir do número total de páginas... usa os códigos & P e & N. & P imprime o número da página. & N imprime o número total de páginas
'            .CenterHeader = "&G" ' Definir o cabeçalho central (Permitir imagem)
            .CenterHeader = "&D" & " - " & "&T" ' Definir o cabeçalho central texto
            With .CenterHeaderPicture
'                .FileName = "C:.................\reset.jpg"
'                .ColorType = msoPictureAutomatic
'                .LockAspectRatio = msoTrue
'                .Height = myCmPointsBase * 2
            End With
            .OddAndEvenPagesHeaderFooter = True ' true(cabeçalho e rodapés diferem entre páginas ímpares e pares) // false (não diferem)
                With .EvenPage
                    .CenterFooter.Text = "&IImpresso por computador" ' definir o centro para páginas pares
                    .RightFooter.Text = "Página &P de &N" '  definir o rodapé direito para páginas pares
                    With .CenterHeader
'                        .Text = "&G"
                        .Text = "Meu Texto..." ' adicionar aqui texto a ser apresentado
                        With .Picture
'                            .FileName = "C:...............\reset.jpg"
'                            .ColorType = msoPictureAutomatic
'                            .LockAspectRatio = msoTrue
'                            .Height = myCmPointsBase * 2
                        End With
                    End With
                     .RightHeader.Text = "Meu Texto..." ' texto que só irá aparecer nas paginas pares, adicionar aqui texto a ser apresentado
                End With
        End With
'        Unload Me
'        .PrintPreview ' visualizar antes de imprimir
    .PrintOut ' imprimir
End With
'*********************************************************************************************
'properties (LeftHeader, CenterHeader, RightHeader, LeftFooter, CenterFooter, and RightFooter)
'VBA code       /       Description
'_______________/____________________________________________________________________________________
    '&D             Prints the current date.
    '&T             Prints the current time.
    '&F             Prints the name of the document.
    '&A             Prints the name of the workbook tab.
    '&P             Prints the page number.
    '&P+number      Prints the page number plus the specified number.
    '&P-number      Prints the page number minus the specified number.
    '&&             Prints a single ampersand.
    '&N             Prints the total number of pages in the document.
    '&Z             Prints the file path.
    '&G             Inserts an image.
'Format  code    /       Description
'_______________/____________________________________________________________________________________
    '&L             Left aligns the characters that follow.
    '&C             Centers the characters that follow.
    '&R             Right aligns the characters that follow.
    '&E             Turns double-underline printing on or off.
    '&X             Turns superscript printing on or off.
    '&Y             Turns subscript printing on or off.
    '&B             Turns bold printing on or off.
    '&I             Turns italic printing on or off.
    '&U             Turns underline printing on or off.
    '&S             Turns strikethrough printing on or off.
    '&"fontname"    Prints the characters that follow in the specified font. Be sure to include the double quotation marks.
    '&nn            Prints the characters that follow in the specified font size. Use a two-digit number to specify a size in points.
    '&color         Prints the characters in the specified color. User supplies a hexadecimal color value.
    '&"+"           Prints the characters that follow in the Heading font of the current theme. Be sure to include the double quotation marks.
    '&"-"           Prints the characters that follow in the Body font of the current theme. Be sure to include the double quotation marks.
    '&K xx. S nnn   Prints the characters that follow in the specified color from the current theme.
    '               xx is a two-digit number from 1 to 12 that specifies the theme color to use.
    '               S nnn specifies the shade (tint) of that theme color. Specify S as + to produce a lighter shade; specify S as - to produce a darker shade.
    '               nnn is a three-digit whole number that specifies a percentage from 0 to 100.
    '               If the values that specify the theme color or shade are not within the described limits, Excel will use the nearest valid value.
'*********************************************************************************************
End Sub

 

Share this post


Link to post
Share on other sites

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now

×
×
  • Create New...

Important Information

By using this site you accept our Terms of Use and Privacy Policy. We have placed cookies on your device to help make this website better. You can adjust your cookie settings, otherwise we'll assume you're okay to continue.