Antonio Augusto Crovador 0 Posted June 2, 2020 Report Share Posted June 2, 2020 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 post Share on other sites
Rhysand 0 Posted June 6, 2020 Report Share Posted June 6, 2020 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 post Share on other sites
Afonso Mira 1 Posted June 8, 2020 Report Share Posted June 8, 2020 Site Macoratti para Imprimir ListView Afonso Mira 😃 Estagiando por aqui: Kemet Electronics Portugal, S.A. Link to post Share on other sites
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