Imprimir directamente en la impresora con Access

Imprimir directamente en accessVemos como podemos imprimir directamente en la impresora con Access, muy útil cuando queremos imprimir en una impresora de tickets.

Os propongo un código para imprimir directamente en la impresora con Access y que a mi me da muy buenos resultados, en el ejemplo vamos a imprimir el típico ticket de mostrador.
Vamos a comentar las diferentes partes del código y al final te lo pongo todo unido:
Como es normal, al principio de código declaramos todas las variables que van a intervenir en la función:

Function ImprimeTicket()
On Error GoTo hayerror
Dim SqlA As String, RstA As DAO.Recordset, NumeroArchivo As Long, DImpIva As Double, DBase As Double
Dim rst1 As DAO.Recordset, DDto As Double, DIva As Double, DSuma As Double, DImpDto As Double

Ahora abrimos los recordset para recuperar los datos de las tablas o consultas, en nuestro caso son dos:

  • rst1: para la suma de la factura.
  • RstA: donde recuperamos los datos propios de una factura en concreto, en nuestro caso la que coincida con la que tenemos en el formulario abierto.
Set rst1 = CurrentDb.OpenRecordset("Select Suma From SumaFacturaDirecta")
SqlA = "Select * from OrigenFacturasInforme Where idfactura =" & Me.IdFactura
Set RstA = CurrentDb.OpenRecordset(SqlA, dbOpenDynaset)

Ahora, si se cumple la condición, asignamos los valores a las variables:

If RstA.BOF = False Then
  NumeroArchivo = FreeFile
  DDto = RstA!DtoGral
  DIva = RstA!IVA
  DSuma = Round(rst1("Suma"), 2)
  DImpDto = DSuma * DDto / 100
  DBase = DSuma - DImpDto
  DImpIva = Round(DBase * DIva / 100, 2)

Ahora abrimos el puerto donde queramos imprimir, en el LPT1, COM1, COM2, etc.:

Open "COM1" For Output As #NumeroArchivo

En caso de querer imprimir en una impresora de red:
Open "\\NOMBRE-RED\NOMBRE-IMPRESORA" For Output As #NumeroArchivo
Aquí reseñar que en las propiedades de la impresora de red tiene que estar marcada la opción "Imprimir utilizando la cola..." ya que de otra manera no me imprimía.

Luego imprimimos el cuerpo del Ticket puede ser algo así, todo completoquedaría así:

Function ImprimeTicket()
On Error GoTo hayerror
Dim SqlA As String, RstA As DAO.Recordset, NumeroArchivo As Long, DImpIva As Double, DBase As Double
Dim rst1 As DAO.Recordset, DDto As Double, DIva As Double, DSuma As Double, DImpDto As Double

Set rst1 = CurrentDb.OpenRecordset("Select Suma From SumaFacturaDirecta")
   
SqlA = "Select * from OrigenFacturasInforme Where idfactura =" & Me.IdFactura
Set RstA = CurrentDb.OpenRecordset(SqlA, dbOpenDynaset)
If RstA.BOF = False Then
  NumeroArchivo = FreeFile
  DDto = RstA!DtoGral
  DIva = RstA!IVA
  DSuma = Round(rst1("Suma"), 2)
  DImpDto = DSuma * DDto / 100
  DBase = DSuma - DImpDto
  DImpIva = Round(DBase * DIva / 100, 2)
 
  Open "COM1" For Output As #NumeroArchivo
  Print #NumeroArchivo, "NOMBRE EMPRESA"
  Print #NumeroArchivo, "DIRECCION EMPRESA"
  Print #NumeroArchivo, "POBLACION EMPRESA"
  Print #NumeroArchivo, "Tlfs: 666 666 666 - 777 777 777"
  Print #NumeroArchivo, "CIF: B123456789"
  Print #NumeroArchivo, "---------------------------------------"
  Print #NumeroArchivo, RstA("NomCli")
  Print #NumeroArchivo, Nz(RstA("Direccion"), "")
  Print #NumeroArchivo, Nz(RstA("CodPos"), ""); Spc(1); Nz(RstA("localidad"), "")
  Print #NumeroArchivo, "NIF:"; Nz(RstA("Cif"), ""); Spc(1); "Cliente Nro:"; RstA("CodCli")
  Print #NumeroArchivo, "---------------------------------------"
  Print #NumeroArchivo, "Fecha:"; RstA("Fecha"); "Factura Nro:"; RstA("NroFactura")
  Print #NumeroArchivo, "======================================="
  Print #NumeroArchivo, "             T I C K E T               "
  Print #NumeroArchivo, "======================================="
  Print #NumeroArchivo, "Cant Descripcion       Precio     TOTAL"
  Print #NumeroArchivo, "---------------------------------------"
  Do While RstA.EOF = False
   Print #NumeroArchivo, RstA("Cantidad"); Spc(2); RstA("Producto")
   Print #NumeroArchivo, Spc(6); Nz(RstA("CodProducto"), "     "); Spc(8); Nz(Round(RstA("Precio"), 2), ""); Spc(3); Nz(Round(RstA("Importe"), 2), "")
 
   RstA.MoveNext
  Loop
  Print #NumeroArchivo,
  Print #NumeroArchivo,
  Print #NumeroArchivo,
  Print #NumeroArchivo, "             Subtotal:"; Spc(7); DSuma
  Print #NumeroArchivo, "             Dto. "; DDto; "%"; Spc(9); DImpDto
  Print #NumeroArchivo, "             Base Imponible:"; Spc(1); DBase
  Print #NumeroArchivo, "             IVA: "; DIva; "%"; Spc(7); DImpIva
  Print #NumeroArchivo, "             TOTAL:"; Spc(10); DBase + DImpIva; "Eur"
  Print #NumeroArchivo,
  Print #NumeroArchivo,
  Print #NumeroArchivo,
  Print #NumeroArchivo,
  Print #NumeroArchivo,
  Print #NumeroArchivo,
  Print #NumeroArchivo,
  Close #NumeroArchivo    ' Cierra el archivo.
Else
  MsgBox "No hay Registros", vbExclamation + vbOKOnly, "Aviso"
End If
RstA.Close
Set RstA = Nothing
rst1.Close: Set rst1 = Nothing
DoCmd.Close acForm, "VerImprimirFacturaDirecta"
Form_frmFacturaDirecta.Visible = True
Salir:
Exit Function
hayerror:
MsgBox Err.Description
Resume Salir
End Function

Categorías: 

Comentarios

Buenos dias:

He creado un archivo de texto para emitir tickets y lo envio al COM2 (puerto de la impresora de tickets), sin embargo, no lo imprime, tan solo una página del mismo carácter.

Me han comentado que, tal vez, haya que ampliarlo con el código de la impresora.

¿Alguien conoce más del tema?

Gracias

No se que quieres decir con ésto:
He creado un archivo de texto para emitir tickets y lo envio al COM2
me puedes dar más detalles pata intentar ayudarte?

Vamos a ver, ví el artículo publcado en esta misma web.
Open "C:\ARQUEO\ToysFarma\TICKET" For Output As #NumeroArchivo
'Open "COM2" For Output As #NumeroArchivo
Con el segundo Open envias a la impresora de tickets, con el pimer Open, se crea un archivo de texto en el pc. Bie, lo hice así para formatearlo según mis necesidades, pero, al cambiar a la segunda opción:
Open "COM2" For Output As #NumeroArchivo
que se supone envia el archivo de texto al puerto de la impresora, tan solo se imprime un carácter "muchas" veces.

Me han hecho dos comentarios al respecto:
1- poner código para que la impresora IDENTIFIQUE el archivo que le envio, lo cuál no tiene sentido porque, de esta forma, si cambias la impresora, has de cambiar esto
2- modificar el puerto del pc (¿velocidad?, me lo confirma mañana)

El caso es que NO puedo modificar NADA de la impresora, porque, otro programa la usa y NO funcionaría.

Hay algo que se escapa a mis conocimientos

¿Te lo he aclarado?

Gracias por contestar
Victoria

Hola Victoria ¿has podido solucionar ese problema?

He visto este tema en el foro y la verdad es que me ha venido bien, pero hay un problema a la hora de imprimir
¿qué pasa con los caracteres acentuados y ñ? salen caracteres raros, ¿cómo se puede solucionar el problema?

Muchas gracias

Te paso unas funciones de Eduardo Olaz que creo pueden solucionar el tema de imprimir eñes, acentos y otros caracteres en Access cuando queremos imprimir directamente en la impresora, yo no le he probado pero viniendo de Eduardo Olaz seguro que va de maravilla, ya nos contarás, en primer lugar muestra una función para imprimir directamente en la impresora LPT1 y luego otra función para convertir esos caracteres que nos interesan:

Pásale al procedimiento la cadena que quieres imprimir como parámetro

Por ejemplo ImprimirCadena "Esta es una línea" & vbcrlf & "esta es una nueva línea"

_____________________________________________________________

Public Sub ImprimirCadena(Cadena As String)
Dim intFichero As Integer

' La función FreeFile nos da un Nº de archivo disponible
intFichero = FreeFile
Open "LPT1" For Output As #intFichero
' Chr$(12) genera un salto de página
Print #intFichero, Cadena & Chr$(12)
Close #intFichero
End Sub

_____________________________________________________________

Deberás tener en cuenta que con este procedimiento se envían cadenas "tal
cual", como se hacía con MSDOS.

Por ello deberás hacer una conversión previa de caracteres, (Vocales
acentuadas, eñes, etc...)

Te incluyo la función ConvertirATextoDOS que convierte una cadena formato
Windows a formato MSDOS
En la impresora te puede dar problemas con las vocales mayúsculas
acentuadas.
Dependiendo del juego de caracteres que tenga implementado la impresora lo
podrás solucionar.

La llamada final quedaría así:

ImprimirCadena ConvertirATextoDOS("El veloz murciélago hindú, comía feliz
cardillo y kiwi." & vbcrlf & "La cigüeña tocaba el saxofón detrás del
palenque de paja." & vbcrlf & "1234567890" )

Public Function ConvertirATextoDOS(ByVal Cadena As String) As String

'************************************************************************
' ConvertirATextoDOS(Texto) --> Texto
' Función desarrollada por Eduardo Olaz
' Primera versión 26/12/1999
' Última revisión 22/10/2000

'************************************************************************
' parámetros: Texto (por valor, string) Texto en formato Windows
' Valor devuelto (String) Texto convertido a formato MSDOS

Dim strSubCadena As String
Dim lngCadena As Long
Dim lngContador As Long
Dim strCaracter As String * 1

lngCadena = Len(Cadena)

If lngCadena > 0 Then
For lngContador = 1 To lngCadena
strCaracter = Mid$(Cadena, lngContador, 1)
Select Case Asc(strCaracter)
Case 170 ' ª
strCaracter = Chr$(166)
Case 186 ' º
strCaracter = Chr$(167)
Case 161 ' ¡
strCaracter = Chr$(173)
Case 191 ' ¿
strCaracter = Chr$(168)
Case 225 ' á
strCaracter = Chr$(160)
Case 193 ' Á
strCaracter = Chr$(181)
Case 233 ' é
strCaracter = Chr$(130)
Case 201 ' É
strCaracter = Chr$(144)
Case 237 ' í
strCaracter = Chr$(161)
Case 205 ' Í
strCaracter = Chr$(214)
Case 243 ' ó
strCaracter = Chr$(162)
Case 211 ' Ó
strCaracter = Chr$(224)
Case 250 ' ú
strCaracter = Chr$(163)
Case 218 ' Ú
strCaracter = Chr$(233)
Case 252 ' ü
strCaracter = Chr$(129)
Case 220 ' Ü
strCaracter = Chr$(154)
Case 241 ' ñ
strCaracter = Chr$(164)
Case 209 ' Ñ
strCaracter = Chr$(165)
Case 231 ' ç
strCaracter = Chr$(135)
Case 199 ' Ç
strCaracter = Chr$(128)
End Select
strSubCadena = strSubCadena & strCaracter
Next lngContador
End If
ConvertirATextoDOS = strSubCadena
End Function

Dependerá del tipo de impresora y del juego de caracteres que incluya el que
tengas que modificar esta función o no.

Y si queremos alguna de las líneas con otro tamañao de fuente como podemos hacerlo?