Antonio Augusto Crovador Posted June 2, 2020 at 06:42 PM Report Share #618336 Posted June 2, 2020 at 06:42 PM 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 Link to comment Share on other sites More sharing options...
Rhysand Posted June 6, 2020 at 10:52 AM Report Share #618406 Posted June 6, 2020 at 10:52 AM 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 Link to comment Share on other sites More sharing options...
Afonso Mira Posted June 8, 2020 at 08:36 AM Report Share #618413 Posted June 8, 2020 at 08:36 AM Site Macoratti para Imprimir ListView Afonso Mira 😃 Programador de Produção em: Aernnova Évora Link to comment Share on other sites More sharing options...
Recommended Posts
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 accountSign in
Already have an account? Sign in here.
Sign In Now