Objeto Printer - Ejemplo pistola.

[pedroesca]

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

Código: [Seleccionar]

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)

Código: [Seleccionar]

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

Código: [Seleccionar]

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

Código: [Seleccionar]

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

Código: [Seleccionar]

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

Código: [Seleccionar]

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

Código: [Seleccionar]

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

Código: [Seleccionar]

Public Sub PrintLine()
    Printer.Line (MargenIzq, Printer.CurrentY + 50)-(Printer.Width - MargenDer, Printer.CurrentY + 50), &H808080
End Sub
10. Rutina auxiliar - Imprimir imagen

Código: [Seleccionar]

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

Código: [Seleccionar]

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.

[YAcosta]

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

[pedroesca]

Si, casualmente todos los reportes son disparados previa vista en un form (y en un grid consecuentemente).

[E N T E R]

Interesante amigo pedro, vamos estar probando tu aporte.

Gracias por compartir.

[Bazooka]

Se ve bueno! y sería bienvenido con un ejemplito para tomarlo todo!! de una!!!!

gracias!!!

[Bazooka]

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?

[cobein]

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.

[Bazooka]

Barbaro Cobein muchas gracias!!

[pedroesca]

Hola de vuelta! Bazooka, esos datos los tomás desde un grid o una matriz?

[Bazooka]

DE una matriz!!