Private Sub imprimir()
' Imprimir
'Imprimir
Dim BeginPage As Long, EndPage As Long, NumCopies As Long, Orientation As Long, Tell As Long
Dim i As Integer
Dim fuente As StdFont
Set fuente = Printer.Font
'Set fuente = Printer.Font
CommonDialog1.CancelError = True
On Error GoTo ErrHandler
CommonDialog1.Flags = &H40&
CommonDialog1.ShowPrinter
BeginPage = CommonDialog1.FromPage
EndPage = CommonDialog1.ToPage
NumCopies = CommonDialog1.Copies
Printer.Orientation = CommonDialog1.Orientation
With Printer
If .Orientation = 1 Then
.Orientation = vbPRORPortrait
Else
.Orientation = vbPRORLandscape
End If
End With
On Error Resume Next
Dim numCols As Integer
Dim filas As Long
encabezado
listarcolumnas
If i = 24 Then
Printer.NewPage
encabezado
End If
Printer.Print
Set Printer.Font = fuente
Printer.EndDoc
' Set Printer.Font = fuente
Exit Sub
ErrHandler:
' El usuario hizo clic en el botón Cancelar.
Exit Sub
End Sub
Private Sub listarcolumnas()
Dim AnchoPapel As Integer
Dim MargenIzquierdo As Integer
Dim numCols As Integer
Dim filas As Long
Dim ultimafila As Long
Dim k As Long, j As Long, i As Integer, n As Integer, anchocol As Integer
Dim linea As String
Dim margen As Integer
Dim fuente As StdFont
Set fuente = Printer.Font
numCols = 9
Printer.FontName = "Courier New" ' una fuente monoespaciada, si no el trabajo es más laborioso...
filas = ((List1.ListCount + 1) \ numCols)
ultimafila = ((List1.ListCount + 1) Mod numCols) ' columnas que tendrá la última fila.
anchocol = ((AnchoPapel - MargenIzquierdo) \ numCols)
For k = 0 To filas - 1
n = margen
For i = 0 To numCols - 1
Printer.CurrentX = n ' imprime el texto de la columna 'i'
Printer.Print List1.List(j + i)
n = (n + anchocol)
Next
j = (j + numCols)
Printer.CurrentY = (Printer.CurrentY + Printer.TextHeight("t")) ' el textheight depende de la fuente seleccionada en la impresora, no importa el texto entre paréntesis... es fijo para la fuente.
Next
If (ultimafila > 0) Then ' la última fila tiene 1 o más columnas, pero menos que 'numcols'.
n = margen
For i = 0 To ultimafila - 1
Printer.CurrentX = n ' imprime el texto de la columna 'i'
Printer.Print List1.List(j + i)
n = (n + anchocol)
Next
End If
Set Printer.Font = fuente
End Sub
Private Sub encabezado()
Printer.Font.Name = "Courier"
Printer.Font.Size = 10
Printer.FontBold = True
Printer.Print Tab(5); "HORA: " & UCase(Format(Now, "hh:mm ")); Tab(80); "Fecha:"; Date
Printer.Font.Name = "Arial"
Printer.Font.Size = 10
Printer.FontBold = True
Printer.DrawWidth = 10
Printer.DrawStyle = 2
Printer.CurrentX = 4000
Printer.CurrentY = 0
Printer.Print "Listado de Almacen"
Printer.CurrentY = 1000
Printer.CurrentX = 200: Printer.Print "Codigo"
Printer.CurrentY = 1000
Printer.CurrentX = 1000: Printer.Print "Stock"
Printer.CurrentY = 1000
Printer.CurrentX = 2900: Printer.Print "Articulo"
Printer.CurrentY = 1000
Printer.CurrentX = 5000: Printer.Print "Precio"
Printer.CurrentY = 1000
Printer.CurrentX = 6000: Printer.Print "Impuesto"
Printer.CurrentY = 1000
Printer.CurrentX = 7200: Printer.Print "Uds.Caja"
Printer.CurrentY = 1000
Printer.CurrentX = 8300: Printer.Print "Umbral"
Printer.CurrentY = 1000
Printer.CurrentX = 9500: Printer.Print "Pedido"
Printer.CurrentY = 1000
Printer.CurrentX = 10500: Printer.Print "En Oferta"
End Sub
Mostrar Mensajes
