Dim i As Long
Dim L As Long
Dim c As Long
Dim colsize() As Variant
Dim Altura As Long
Dim Posicao As Long
Dim mrg_col As Long
Dim registros() As Variant
Dim Total As Long
Dim Title As String
Dim posini As Integer
Dim Pagina As Integer
Dim Lista As MSComctlLib.ListView
Dim tamanhotitulofonte As String
Dim estilotitulofonte As String
Dim bold1 As Boolean
Dim tamanhocabecalhofonte As String
Dim estilocabecalhofonte As String
Dim bold2 As Boolean
Dim tamanholistafonte As String
Dim estilolistafonte As String
Dim bold3 As Boolean
Dim mrg_altura As Long
Dim espacamento As Integer
Dim nCol As Byte
Dim nLin As Long
Private Sub montaRpt()
RptHeader
PageHeader
rptConteudo
RptReportFooter
End Sub
Private Sub MSClvw()
nCol = Lista.ColumnHeaders.Count
nLin = Lista.ListItems.Count
Dim lst As MSComctlLib.ListItems
Set lst = Lista.ListItems
ReDim registros(nLin, nCol)
For c = 1 To nCol
registros(0, c) = Lista.ColumnHeaders(c).text
Next c
For L = 1 To nLin
For c = 1 To nCol
If c = 1 Then
registros(L, 1) = lst.Item(L).text
Else
registros(L, c) = lst.Item(L).SubItems(c - 1)
End If
Next c
Next L
End Sub
Public Sub Imprime(ByVal list As Object, ByVal Titulo As String, ByVal loja As Variant)
Dim setup As New frmSetupImp
Dim size As Double
Printer.PaperSize = vbPRPSA3
Printer.Copies = 1
mrg_col = 0
mrg_altura = 300
Pagina = 1
Title = Titulo
setup.Show 1
nLin = 0
nCol = 0
Set Lista = list
If TypeOf list Is MSComctlLib.ListView Then
MSClvw
End If
tamanhotitulofonte = setup.tamtitulofonte
estilotitulofonte = setup.estilotitulofonte
bold1 = setup.bold1
tamanhocabecalhofonte = setup.tamcabfonte
estilocabecalhofonte = setup.estilocabfonte
bold2 = setup.bold2
tamanholistafonte = setup.tamlistafonte
estilolistafonte = setup.estilolistafonte
bold3 = setup.bold3
ReDim colsize(nCol)
For i = 0 To nCol
colsize(i) = 0
Next i
With Printer
For c = 1 To nCol
If InStr(1, Trim(registros(0, c)), " ", vbBinaryCompare) <> 0 Then
If colsize(c) < .TextWidth(Trim(Mid$(registros(0, c), 1, InStr(1, registros(0, c), " ", vbBinaryCompare)))) Then
colsize(c) = .TextWidth(Trim(Mid$(registros(0, c), 1, InStr(1, registros(0, c), " ", vbBinaryCompare))))
End If
If colsize(c) < .TextWidth(Trim(Mid$(registros(0, c), InStr(1, registros(0, c), " ", vbBinaryCompare)))) Then
colsize(c) = .TextWidth(Trim(Mid$(registros(0, c), InStr(1, registros(0, c), " ", vbBinaryCompare))))
End If
Else
If colsize(c) < .TextWidth(Trim(registros(0, c))) Then
colsize(c) = .TextWidth(Trim(registros(0, c)))
End If
End If
Next c
For c = 1 To nCol
For L = 0 To nLin
If colsize(c) < .TextWidth(registros(L, c)) Then
colsize(c) = .TextWidth(registros(L, c))
End If
Next L
Next c
Total = 0
For i = 1 To nCol
Total = Total + colsize(i)
Next i
If Total + (nCol * 100) > .ScaleWidth - 200 Then
.Orientation = 2
If Total > .ScaleWidth - 100 Then
MsgBox ("Tamanho da Estrutura Excede os limites do papel. Diminua opções de tamanho de fonte,margem ou elimine colunas!")
End If
Else
.Orientation = 1
End If
size = Printer.ScaleWidth - Total
size = size / 3
espacamento = size
size = size / nCol
mrg_col = size
size = nCol * mrg_col
size = size + Total
End With
montaRpt
End Sub
Private Sub cabecalho(ByVal loja As Variant)
With Printer
Dim Padrao As String
Padrao = "Loja:" & loja & " Data:" & Format(Now, "dd/mm/yyyy") & " Versão" & versao
Printer.Print
.FontName = estilocabecalhofonte
.FontSize = tamanhocabecalhofonte
.FontBold = bold2
Printer.Print String(210, "_")
Call ImprimeTextoAlinhado(Padrao, "Centro")
Call ImprimeTextoAlinhado(String(210, "_"), "Centro")
End With
End Sub
Private Sub categorias(ByVal registros As Variant, ByVal espacamento As Long)
Dim Backup As Integer
With Printer
.FontBold = True
Altura = .CurrentY
Backup = 0
.CurrentY = Altura + 187
For c = 1 To nCol
If InStr(1, registros(0, c), " ", vbBinaryCompare) <> 0 Then
.CurrentY = Altura
Backup = .CurrentX
If c = 0 Then
.CurrentX = 0
End If
.CurrentX = .CurrentX + espacamento + (mrg_col / 2)
Printer.Print Trim(Mid$(registros(0, c), 1, InStr(1, registros(0, c), " ", vbBinaryCompare)))
.CurrentX = Backup
.CurrentX = .CurrentX + espacamento + (mrg_col / 2)
Printer.Print Trim(Mid$(registros(0, c), InStr(1, registros(0, c), " ", vbBinaryCompare)))
Posicao = Posicao + colsize(c) + mrg_col
.CurrentX = Posicao + .CurrentX
Else
.CurrentY = Altura + 187
.CurrentX = Printer.CurrentX + espacamento + (mrg_col / 2)
Printer.Print registros(0, c)
Posicao = Posicao + colsize(c) + mrg_col
.CurrentX = Posicao + Printer.CurrentX
End If
Next c
Printer.Print
.FontBold = bold3
End With
End Sub
Private Sub ImprimeTextoAlinhado(Texto As String, Alignment As String)
Select Case Alignment
Case "Centro"
Printer.CurrentX = (Printer.ScaleWidth - Printer.TextWidth(Texto)) / 2
Case "Esquerda"
Printer.CurrentX = 0
Case "Direita"
Printer.CurrentX = Printer.ScaleWidth - Printer.TextWidth(Texto)
End Select
Printer.Print Texto
End Sub
Private Sub PageHeader()
With Printer
.CurrentX = 0
cabecalho (LojaSistema)
.FontName = estilolistafonte
.FontSize = CInt(tamanholistafonte)
.FontBold = bold3
Printer.Print
Altura = Printer.CurrentY
End With
Call categorias(registros, espacamento)
End Sub
Private Sub rptConteudo()
With Printer
For L = 1 To nLin
If .CurrentY > .ScaleHeight - 1200 Then
RptPageFooter
.NewPage
.CurrentY = mrg_altura
.CurrentX = 0
Call PageHeader
Printer.Print
End If
Altura = .CurrentY
For c = 1 To nCol
.CurrentX = .CurrentX + espacamento + (mrg_col / 2)
Printer.Print registros(L, c)
.CurrentY = Altura
Posicao = Posicao + colsize(c) + mrg_col
.CurrentX = Posicao + .CurrentX
Next c
Posicao = 0
Printer.Print
Next L
End With
End Sub
Private Sub RptHeader()
With Printer
Printer.Print
.FontName = estilotitulofonte
.FontSize = CInt(tamanhotitulofonte)
.FontBold = bold1
Call ImprimeTextoAlinhado(Title, "Centro")
End With
End Sub
Private Sub RptPageFooter()
With Printer
Printer.Print
.FontBold = True
.CurrentY = .ScaleHeight - 800
Call ImprimeTextoAlinhado(String(210, "_"), "Centro")
Call ImprimeTextoAlinhado("Página " & Pagina & " ", "Direita")
Pagina = Pagina + 1
.FontBold = bold3
End With
End Sub
Private Sub RptReportFooter()
With Printer
Printer.Print
.FontBold = True
.CurrentY = .ScaleHeight - 800
Call ImprimeTextoAlinhado(String(210, "_"), "Centro")
Call ImprimeTextoAlinhado("Página " & Pagina & " ", "Direita")
.EndDoc
End With
End Sub