Private Type lineas
Tarea As String
Linea As String
Cant As String
PrecioUnitario As String
PrecioTotal As String
Descripcion As String
Nhoras As String
End Type
Dim Filas() As lineas
Dim x As Integer 'numero de registro de "Filas"
Dim I As Integer
Dim Contrato As String
Dim Contratista As String
Dim Ejec As String
Dim Fenvio As String
Dim Tarea As String
Dim Tags As String
Dim DescripcionTrabajos As String
Private Sub Form_Load()
x = 2
ReDim Filas(x)
'rellenamos los datos de las variables de prueba
Contrato = "199827"
Contratista = "Antonio Fdez."
Ejec = "324"
Fenvio = "19/11/06"
Tarea = "EEAACC"
Tags = "PAOEIRD"
DescripcionTrabajos = "Inmunizacion de las bacterias gastroinservibles " & _
"de la traqueotomizacion"
Filas(0).Tarea = "111"
Filas(0).Linea = "11"
Filas(0).Cant = "1111"
Filas(0).PrecioUnitario = "11111 €"
Filas(0).PrecioTotal = "11111 €"
Filas(0).Descripcion = "Rendicion incondicional de las almorranas involuntarias"
Filas(0).Nhoras = "34 H"
Filas(1).Tarea = "222"
Filas(1).Linea = "22"
Filas(1).Cant = "2222"
Filas(1).PrecioUnitario = "22222 €"
Filas(1).PrecioTotal = "22222 €"
Filas(1).Descripcion = "Caperucita solo tiene 16 primaveras sin flores" & _
" sin vida, va tanto el cantaro a la fuente que " & _
" se acaba rompiendo esternocleidomastoideo de la sin razon"
Filas(1).Nhoras = "34 H"
Filas(2).Tarea = "333"
Filas(2).Linea = "33"
Filas(2).Cant = "3333"
Filas(2).PrecioUnitario = "33333 €"
Filas(2).PrecioTotal = "333333 €"
Filas(2).Descripcion = "quiero volar lejos de aqui escapar"
Filas(2).Nhoras = "34 H"
Impresion.Width = 297 'tamaño del formulario (solo para hacer pruebas)
Impresion.Height = 210 'tamaño del formulario (solo para hacer pruebas)
Me.Show
IMPRIMIR
End Sub
Public Function IMPRIMIR()
Dim PosY As Integer 'posicion columna
Dim PosX As Integer 'posicion linea
Dim Linea As Integer 'el tamaño maximo de la linea
Dim Text As String 'va guardando el texto por bloques
Dim Caracter As String 'recoge los caracteres
Dim Palabra As String 'recoge la palabra
Dim Dia As String
Dim Mes As String
Dim Ano As String
'le decimos la orientacion de las paginas, en este caso apaisada
Printer.Orientation = 2
'modo de escala en milimetros
Printer.ScaleMode = 6
'le decimos el tamaño de la escala, en este caso dinA4 en milimetros
Printer.ScaleWidth = 297
Printer.ScaleHeight = 210
'el tamaño de la letra
Printer.FontSize = 9
Printer.FontBold = False
'funcion colocar: el primer valor es el texto, el segundo la posicion _
en la fila y el tercero la posicion en la columna-> colocar texto, PosicionFila, _
PosicionColumna
colocar Contrato, 5, 27
colocar Contratista, 41, 27
colocar Ejec, 100, 27
'Desglosamos fecha envio (ajustamos a las marcas del impreso / /)
Dia = Mid$(Fenvio, 1, 2)
Mes = Mid$(Fenvio, 4, 2)
Ano = Mid$(Fenvio, 7, 2)
colocar Dia, 228, 27
colocar Mes, 238, 27
colocar Ano, 248, 27
colocar Tarea, 1, 50
colocar Tags, 21, 50
colocar DescripcionTrabajos, 51, 50
PosY = 190
'marcamos el tamaño máximo que puede tener la descripcion por linea
Linea = 41
For I = 0 To x
colocar Filas(I).Tarea, 1, PosY
colocar Filas(I).Linea, 21, PosY
colocar Filas(I).Cant, 35, PosY
colocar Filas(I).PrecioUnitario, 52, PosY
colocar Filas(I).PrecioTotal, 74, PosY
colocar Filas(I).Nhoras, 183, PosY
Palabra = ""
Text = ""
x = 1
'imprimimos la descripcion (segun el tamaño de linea)
'Funcionamiento: le damos un texto de cualquier tamaño y
'esta parte nos lo ajustará según el tamaño de linea que escojamos
'en tantas filas como sea necesario, respetando las palabras completas.
Do
Caracter = Mid(Filas(I).Descripcion, x, 1)
If Caracter <> " " And x <> Len(Filas(I).Descripcion) Then
Palabra = Palabra & Caracter
Else
'en el case que se ajuste a la linea
If Len(Text) + Len(Palabra) = Linea Then
colocar Text & " " & Palabra, 98, PosY
Palabra = ""
Text = " "
PosY = PosY + 5
'en el caso que sea mayor que la linea
ElseIf Len(Text) + Len(Palabra) > Linea Then
colocar Text, 98, PosY
PosY = PosY + 5
Text = Palabra
Palabra = ""
'en el case que sea la ultima linea
ElseIf x = Len(Filas(I).Descripcion) Then
colocar Text & " " & Palabra & Right(Filas(I).Descripcion, 1), 98, PosY
PosY = PosY + 5
Text = ""
Palabra = ""
Else 'todavía es menor que el tamaño de la linea
Text = Text & " " & Palabra
Palabra = ""
End If
End If
x = x + 1
Loop Until x > Len(Filas(I).Descripcion)
Next
' mandar el trabajo a imprimir
Printer.EndDoc
End Function
Private Function colocar(texto As String, x As Integer, Y As Integer)
Printer.CurrentX = x
Printer.CurrentY = Y
Printer.Print texto
End Function
'Para evitar gastar papel "a lo tonto", lo mejor es hacer pruebas en un _
'formulario para ello, comentar las lineas:
'Printer.Orientation
'Printer.EndDoc
'y sustituir en todo el formulario "printer" por el nombre del formulario, _
'en este caso
