Código extraido de Elguille.info, no olvides visitar mi blog: www.mundocodes.blogspot.com


#If Win32 Then
'Declaración para 32 bits
Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hWnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, lParam As Any) As Long

#Else
'Declaración para 16 bits
Declare Function SendMessage Lib "User" _
(ByVal hWnd As Integer, ByVal wMsg As Integer, _
ByVal wParam As Integer, lParam As Any) As Long

#End If
Public Sub gsImprimir(qControl As Control, Optional vLPT, Optional vDirecto)
'--------------------------------------------------------------
'Procedimiento genérico para imprimir (31/Ago/97)
'
'Entrada:
' qControl control a imprimir (TextBox, ListBox)
' vLPT Impresora de salida, sólo para impresión directa
' vDirecto Si se imprime directamente o se usa el controlador
'--------------------------------------------------------------
Const MAXLINEA = 136 'Número de caracteres máximos por línea

Dim nFicSal As Integer
Dim sLpt As String
Dim i As Long
Dim j As Integer
Dim k As Long
Dim sTmp As String
Dim sImpresora As String
Dim bDirecto As Boolean
Dim tPrinter As Printer

Dim L1&, L2&
Const EM_GETLINECOUNT = &HBA
Const EM_LINEINDEX = &HBB
Const EM_LINELENGTH = &HC1

Set tPrinter = Printer

'El port de impresora a usar
If IsMissing(vLPT) Then 'Si no se especifica,
sLpt = "LPT1:" 'usar LPT1:
Else
sLpt = CStr(vLPT)
End If
'Si se va a imprimir directamente en el puerto
'o se va a usar el controlador de Windows
If IsMissing(vDirecto) Then 'Si no se especifica,
bDirecto = False 'usar el controlador de Windows
Else
bDirecto = CBool(vDirecto)
End If

'Quitarle los dos puntos, si lo tiene,
'seguramente no es necesario, pero...
If Right$(sLpt, 1) = ":" Then
sLpt = Left$(sLpt, Len(sLpt) - 1)
End If

If TypeOf qControl Is ListBox Then
'Número de items en el listbox
k = qControl.ListCount
Else
'Número de líneas del TextBox
k = SendMessage(qControl.hWnd, EM_GETLINECOUNT, 0, 0&)
End If
If bDirecto Then
'Imprimir directamente...
j = 0
nFicSal = FreeFile
'Abrir el puerto de impresora para salida...
Open sLpt For Output As nFicSal
Print #nFicSal, Chr$(15); 'Letra pequeña
Else
'Usar controlador de Windows
tPrinter.Print ""
tPrinter.Print ""
End If
'Se imprimirá cada una de las líneas del listbox o del textbox
'-------------------------------------------------------------
'En este último caso no sería necesario,
'ya que se puede imprimir TODO de una vez, usando esto:
'Printer.Print qControl.Text 'usando el controlador
'Print #nFicSal, qControl.Text 'imprimiendo directamente
'-------------------------------------------------------------
For i = 0 To k - 1
DoEvents
If TypeOf qControl Is ListBox Then
If bDirecto Then
Print #nFicSal, Left$(qControl.List(i), MAXLINEA)
Else
tPrinter.Print Left$(qControl.List(i), MAXLINEA)
End If
Else
'Primer carácter de la línea actual
L1 = SendMessage(qControl.hWnd, EM_LINEINDEX, i, 0&) + 1
'Longitud de la línea actual
L2 = SendMessage(qControl.hWnd, EM_LINELENGTH, L1, 0&)
If L2 > MAXLINEA Then L2 = MAXLINEA
If bDirecto Then
Print #nFicSal, Mid$(qControl.Text, L1, L2)
j = j + 1
'cada 60 líneas en una página
If j = 60 Then
Print #nFicSal, Chr$(12);
j = 0
End If
Else
tPrinter.Print Mid$(qControl.Text, L1, L2)
End If
End If
Next
If bDirecto Then
'Restaurar el tamaño de la fuente a normal
Print #nFicSal, Chr$(18);
'Si j vale CERO, ya se imprimió un salto de página
'en caso contrario, echar la hoja fuera
If j Then
Print #nFicSal, Chr$(12);
End If
Close nFicSal
Else
tPrinter.EndDoc
End If
End Sub