Visual Basic Foro
Programación => Visual Basic 6 => Mensaje iniciado por: pedroesca en Diciembre 17, 2012, 06:29:06 pm
-
Buenas nuevamente! hace unas horas tuve un inconveniente y lo había posteado aquí mismo, y como carecía de tiempo, solucioné con el objeto Printer, es decir, toda la impresión por código, y el "preview" de dicha impresión la hago con una impresora virtual que genera PDF, por lo tanto el visor de informe, es el Adobe Reader.
Bueh, vamos a los bifes:
1. Encabezado
Sub Encabezado()
OpenRECORDSET "SELECT Top 1 * From SYS_DATA_EMP", lectura, Rs
SetFont False, False, False, 7, "Arial", vbBlack
Print_TEXT MargenIzq, MargenSup, Rs!NombreFantasia
Print_TEXT MargenIzq, 650, Rs!Direccion ' & " - CUIT: " & Rs!CUIT & " - Ing. Brutos: " & Rs!IngBrutos & " - " & Rs!Direccion
Rs.Close
Printer.CurrentX = 1700
Printer.CurrentY = 800
Printer.Line (MargenIzq, Printer.CurrentY + 100)-(Printer.Width - MargenDer, Printer.CurrentY + 100), vbBlack
Printer.Print
Printer.Print
End Sub[code]
[b][i]2. CUERPO de Informe (Grid) [/i][/b]
[code]Public Sub PrintGRID(Grid1 As MSHFlexGrid, COLdesde As Long)
Dim WidthCol() As Long
Dim TabCol() As Long
''''1º cantidad de columnas
With Grid1
ReDim WidthCol(COLdesde To .Cols - 1)
ReDim TabCol(COLdesde To .Cols - 1)
''' 2º establecemos los anchos de los encabezados de columnas
For i = COLdesde To .Cols - 1
WidthCol(i) = Printer.TextWidth(.TextMatrix(0, i))
Next i
''' 3º comparamos los valores de cada columna para ver si son mayores a los almacenados
''' a través de los encabezados
For i = COLdesde To .Cols - 1
For J = 0 To .Rows - 1
If Printer.TextWidth(.TextMatrix(J, i)) > WidthCol(i) Then
WidthCol(i) = Printer.TextWidth(.TextMatrix(J, i))
End If
Next J
Next i
TabCol(COLdesde) = MargenIzq
For i = COLdesde + 1 To .Cols - 1
TabCol(i) = (WidthCol(i - 1) + TabCol(i - 1)) + 10
Next i
End With
Printer.Line (MargenIzq, Printer.CurrentY + 50)-(Printer.Width - MargenDer, Printer.CurrentY + 50), &H808080
'' imprimimos los encabezados------------------------------------------------------------------------
SetFont True, False, False, 8, "Arial Narrow"
Printer.CurrentX = MargenIzq
LineA = Printer.CurrentY
For JRow = COLdesde To Grid1.Cols - 1
With Grid1
Printer.CurrentY = LineA
Printer.CurrentX = TabCol(JRow): Printer.Print .TextMatrix(0, JRow)
End With
Next JRow
Printer.Line (MargenIzq, Printer.CurrentY + 50)-(Printer.Width - MargenDer, Printer.CurrentY + 50), &H808080
'' imprimimos el contenido de la grilla
SetFont False, False, False, 7, "Tahoma"
Printer.CurrentX = MargenIzq
LineA = Printer.CurrentY
TabCol(COLdesde) = MargenIzq
With Grid1
For i = 1 To .Rows - 1
''''CONTROLAMOS EL SALTO DE PÁGINA'''''''''''''''''
If Printer.CurrentY + MargenInf >= Printer.Height - MargenInf Then
Call PIEdePagina
Printer.NewPage
'Encabezado Logo
'FondoAGUA Fondo
LineA = Printer.CurrentY + 600
SetFont False, False, False, 7, "Tahoma"
Else
LineA = Printer.CurrentY + 100
End If
GTab = MargenIzq
For J = COLdesde To .Cols - 1
Printer.CurrentY = LineA: Printer.CurrentX = TabCol(J): Printer.Print .TextMatrix(i, J)
Next J
Next i
End With
Printer.Line (MargenIzq, Printer.CurrentY + 100)-(Printer.Width - MargenDer, Printer.CurrentY + 100), &H808080
End Sub
3. CUERPO de Informe (Fondo de Agua)
Sub FondoAGUA(LOGO As PictureBox)
On Error GoTo errHandler
ANCHO = Printer.Width
ALTO = Printer.Height / 2
Printer.PaintPicture LOGO.Picture, (Printer.Width / 2) - (ANCHO / 2), (Printer.Height / 2) - (ALTO / 2), ANCHO, ALTO
errHandler:
If err.Number = 91 Then ''' cuando no hay imagen pa imprimir
err.Clear
Exit Sub
End If
End Sub
4. Pie de Página
Sub PIEdePagina()
Printer.CurrentY = Printer.Height - 700
Printer.Line (MargenIzq, Printer.CurrentY + 100)-(Printer.Width - MargenDer, Printer.CurrentY + 100), &H808080
SetFont False, True, False, 6, "Tahoma", &H808080
sql = "SELECT Top 1 * From SYS_DATA_EMP;"
If Rs.State = 1 Then Rs.Close
Rs.Open sql, Cn, adOpenStatic, adLockReadOnly
Centrar Rs!NombreFantasia '& " - " & Rs!CondIVA & " - CUIT: " & Rs!CUIT & " - Ing. Brutos: " & Rs!IngBrutos & " - " & Rs!Direccion
Rs.Close
SetFont False, False, False, 7, "Agency FB", &H808080
Centrar "ecinQ - Desarrollo de Software"
End Sub
5. Final de Impresión
Sub FINALdeImpresion()
Printer.CurrentY = Printer.Height - 1000
'Printer.Line (MargenIzq, Printer.CurrentY + 100)-(Printer.Width - MargenDer, Printer.CurrentY + 100), &H808080
SetFont False, False, False, 7, "Tahoma"
Printer.CurrentX = MargenDer
Printer.Print "Impreso el " & Format(Date, "Long Date") & " a las " & Format(time, "Long Time")
End Sub
6. Rutina auxiliar - Ajustar Fuente
Sub SetFont(negrita As Boolean, cursiva As Boolean, subr As Boolean, _
tamanio As Integer, fuente As String, Optional Color As Variant = vbBlack)
'''
Printer.FontBold = negrita
Printer.FontItalic = cursiva
Printer.FontUnderline = subr
Printer.FontSize = tamanio
Printer.FontName = fuente
Printer.ForeColor = Color
End Sub
7. Rutina auxiliar - Imprimir texto
Public Sub Print_TEXT(X As Long, Y As Long, TEXTO As String)
Printer.CurrentX = X
Printer.CurrentY = Y
Printer.Print TEXTO
End Sub
8. Rutina auxiliar - Centrar Texto
Sub Centrar(TEXTO As String)
ANCHOTOTAL = Printer.Width
AnchoString = Printer.TextWidth(TEXTO)
VALOR = AnchoString / 2
Printer.CurrentX = ANCHOTOTAL / 2
Printer.CurrentX = Printer.CurrentX - VALOR
Printer.Print TEXTO
End Sub
9. Rutina auxiliar - Imprimir Línea
Public Sub PrintLine()
Printer.Line (MargenIzq, Printer.CurrentY + 50)-(Printer.Width - MargenDer, Printer.CurrentY + 50), &H808080
End Sub
10. Rutina auxiliar - Imprimir imagen
Sub PrintIMAGE(Imagen As StdPicture, ANCHO As Long, ALTO As Long)
On Error GoTo errHandler
ANCHO = 500
ALTO = 500
picHeight = Imagen.Height
picWIDTH = Imagen.Width
MAXHEIGHT = 1000: MAXWIDTH = 1000
If picHeight > picWIDTH Then
'if height is more than width
'get Scale factor based on height
sFactor = MAXHEIGHT / picHeight
Else
'if height is less than width
'get Scale factor based on height
sFactor = MAXWIDTH / picWIDTH
End If
'printer.PaintPicture Photo, StartLeft, StartTop, picWidth * sFactor, picHeight * sFactor
Printer.PaintPicture Imagen, 500, 500, picWIDTH * sFactor, picHeight * sFactor
Exit Sub
errHandler:
If err.Number = 91 Then ''' cuando no hay imagen pa imprimir
err.Clear
Exit Sub
End If
End Sub
11. IMPRIMIR INFORME
Sub Imprimir( _
Titulo As String, _
subTitulo As String, _
Optional LOGO As PictureBox, _
Optional Fondo As PictureBox, _
Optional grid As MSHFlexGrid, _
Optional TOTAL As String)
OpenRECORDSET "SELECT Top 1 PrinterSys From SYS_CONFIG", lectura, Rs
If Rs.RecordCount > 0 Then
If Trim(Rs!PrinterSys) <> "" Then
For Each Prt In Printers
If Prt.DeviceName = Rs!PrinterSys Then Set Printer = Prt
Next
End If
End If
Rs.Close
Printer.PaperSize = vbPRPSA4
Printer.Orientation = vbPRORPortrait
SetFont False, False, False, 10, "Arial Narrow", vbBlack
Encabezado
FondoAGUA Fondo
SetFont True, True, True, 10, "Tahoma"
Print_TEXT MargenIzq, 700, Titulo
SetFont False, False, False, 8, "Tahoma", vbBlack
Printer.CurrentX = MargenIzq
Printer.Print subTitulo
Printer.Print
Printer.Print
PrintGRID grid, 2
Printer.CurrentX = MargenIzq
If Val(TOTAL) > 0 Then
Printer.Print "TOTAL: $ " & TOTAL
End If
FINALdeImpresion
PIEdePagina
Printer.EndDoc
End Sub
Espero vuestras opiniones y comentarios.
Saludos.
-
Esta interesante, lo mismo, cuando llegue a casa me prepara un cafe y le hecho una mirada mas profusa, aunque a simple vista no creo que tenga mucho que aportar porque al parecer lo tienes trabajadiro. El único detallito es ¿porque bajarlo a un grid para luego subirlo al print si se puede hacer directamente desde el rs al print?. Si es porque se necesita ver el grid antes de imprimir tons ta bien, sino... pues leere el codigo luego... saludos
-
Si, casualmente todos los reportes son disparados previa vista en un form (y en un grid consecuentemente).
-
Interesante amigo pedro, vamos estar probando tu aporte.
Gracias por compartir.
-
Se ve bueno! y sería bienvenido con un ejemplito para tomarlo todo!! de una!!!!
gracias!!!
-
HOLA para no empezar otro hilo lo tomo en este por que estoy tratando de generar un informe con una rutina que tome de este post y la adpte pero tengo el siguiente problema:
quiero imprimir en 3 columnas tabuladas algo como esto
Listado de productos precio Ctdad.
Articulo 1 $ 150.25 12
Articulo 2 un poco mas largo $ 345.00 24
pero yo quiero enviar la instruccion print en una sola linea :
cadena= "Articulo 1 " & vbTab & "$ 150.25" & vbTab & "12"
Print Cadena
cadena= "Articulo 2 un poco mas largo " & vbTab & "$ 345.00" & vbTab & "24"
Print Cadena
PEro me sale todo chueco y no coinciden las columnas !!
Como tengo que hacer?
-
Una mabera simple es hacer asi
Private Type tCols
sCol1 As String * 50
sCol2 As String * 20
sCol3 As String * 20
End Type
Private Sub Form_Load()
Dim tCol As tCols
tCol.sCol1 = "Articulo 2 un poco mas largo "
tCol.sCol2 = "$ 345.00"
tCol.sCol3 = "24"
Debug.Print tCol.sCol1 & tCol.sCol2 & tCol.sCol3
tCol.sCol1 = "Articulo 1 "
tCol.sCol2 = "$ 150.25"
tCol.sCol3 = "12"
Debug.Print tCol.sCol1 & tCol.sCol2 & tCol.sCol3
End Sub
y en Tcols podes definir las columnas con su ancho maximo, de esa manera si el texto supera el tamaño definido, el mismo se corta al tamaño maximo y siempre queda todo alineado.
-
Barbaro Cobein muchas gracias!!
-
Hola de vuelta! Bazooka, esos datos los tomás desde un grid o una matriz?
-
DE una matriz!!