cambiar impresora predeterminada antes de datareport

[robsergar]

Tengo distintos listados generados con datareport, los cuales quiero redirigir a distintas impresoras en forma automática.
El problema que me encuentro es que el datareport trabaja unicamente con la impresora predeterminada de windows, y la sentencia
Set Printer = printers(N) solamente tarbaja con el objeto printer, pero no con el datareport.
Como hago para cambiar la impresora predeterminada, y que la nueva impresora seleccionada sea tomada por el datareport para imprimir?

Datos adicionales:
Sistema en Visual Basic SP5
Windows XP SP2

Muchas gracias por su ayuda.

[robsergar]

Bueno, aunque sea me contesto yo mismo, aunque no es algo aconsejable !!!

Aca va la solución:


'las dos lineas siguientes hay que pegarlas en un modulo (.bas)
Declare Function WriteProfileString Lib "kernel32" Alias "WriteProfileStringA" (ByVal lpszSection As String, ByVal lpszKeyName As String, ByVal lpszString As String) As Long
Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lparam As String) As Long

'En el formulario

Sub Main()
If Command$ = "" Then

For Each Prt In Printers
Set Printer = Prt
m$ = m$ + vbCrLf + Printer.DeviceName
Next

MsgBox "Para cambiar la impresora determinada, pase un parametro al programa con una única cadena como las mostradas (atención con las mayusculas/minusculas) :" + _
vbCrLf + m$, 64, "ImpDefaut"
Else
For Each Prt In Printers
If InStr(Prt.DeviceName, Command$) > 0 Then Set Printer = Prt: Exit For
Next

r = WriteProfileString("windows", "Device", Printer.DeviceName + "," + Printer.DriverName + "," + Printer.Port)
l = SendMessage(HWND_BROADCAST, WM_WININICHANGE, 0, "windows")
End If


'Este código agregarlo a un boton del formulario

'El comando SET PRINTER sirve unicamente para la impresión con el objeto PRINTER
'Set Printer = Printers(n)

'Estas son las impresoras instaladas en mi computadora
' 2 -->> \\server\HP1010
' 3 -->> \\SERVER\CITIZENREMIT
' 4 -->> \\SERVER\CITIZENFACT
' 5 -->> \\LETICIA\EPSON

' ojo !!!! --->>>>> En tu PC los nombres de las impresoras son diferentes, chequealo !!!!


' LA IMPRESORA POR DEFECTO EN MI XP/SP2 ES LA HP1010

'----------------------------- cambio como predeterminada a una epson lx810 de la computadora LETICIA

di = WriteProfileString("WINDOWS", "DEVICE", "\\LETICIA\EPSON,winspool,Ne05")
l = SendMessage(HWND_BROADCAST, WM_WININICHANGE, 0, ByVal "windows")

'cierro el recordset si esta abierto
If datos.rsivcompras_mes_year.State = 1 Then
datos.rsivcompras_mes_year.Close
End If

' Genero el recordset
datos.ivcompras_mes_year 1, 2005
datos.rsivcompras_mes_year.MoveFirst

'preparo el datareport
rpt_ivc.Sections("encabezado").Controls("mes").Cap tion = "Enero"
rpt_ivc.Sections("encabezado").Controls("anio").Ca ption = "2005"

'cambio la orientación el papel a apaisado
rpt_ivc.Orientation = rptOrientLandscape
rpt_ivc.PrintReport False

'----------------------------- cambio como predeterminada a una Laserjet HP 1010 de la computadora SERVER

di = WriteProfileString("WINDOWS", "DEVICE", "\\SERVER\HP1010,winspool,Ne03:")
l = SendMessage(HWND_BROADCAST, WM_WININICHANGE, 0, ByVal "windows")

datos.rsivcompras_mes_year.MoveFirst
rpt_ivc.PrintReport False

'----------------------------- cambio como predeterminada a una epson lx810 de la computadora LETICIA

di = WriteProfileString("WINDOWS", "DEVICE", "\\LETICIA\EPSON,winspool,Ne05")
l = SendMessage(HWND_BROADCAST, WM_WININICHANGE, 0, ByVal "windows")

datos.rsivcompras_mes_year.MoveFirst
rpt_ivc.PrintReport False

'----------------------------- cambio como predeterminada a una Laserjet HP 1010 de la computadora SERVER

di = WriteProfileString("WINDOWS", "DEVICE", "\\SERVER\HP1010,winspool,Ne03:")
l = SendMessage(HWND_BROADCAST, WM_WININICHANGE, 0, ByVal "windows")

datos.rsivcompras_mes_year.MoveFirst
rpt_ivc.PrintReport False

'Como ven, hago 2 listados en cada impresora, y me queda activada como predeterminada la HP1010

Pedido: Estuve buscando esta solución por internet durante una semana, buscando la solución en Yahoo! y Google en español, italiano y Frances,
que fue donde finalmente encontre parte de este código.
al que le sirva esto, por favor ponga una nueva respuesta en este misma página.

Saludos a todos!

[DarthOrthac]

He utilizado he me ha funcionado perfectamente...

Yo lo he introducido en un modulo. Hay que crear un archivo de texto con el nombre de la impresora que queremos cambiar. Llamamos a la función cambiar impresora con la ruta y nombre del fichero que contiene el nombre de la impresora:

En el archivo de texto pongo el nombre con el que me viene reflejado en impresoras y faxes

Por ejemplo:

Epson C48

Y desde cualquier parte del programa llamamos al procedimiento:

Call CambiarImpresora ("C:\impresora.txt")

A continuación pongo el modulo que he utilizado...

Option Explicit

Declare Function WriteProfileString Lib "kernel32" Alias "WriteProfileStringA" (ByVal lpszSection As String, ByVal lpszKeyName As String, ByVal lpszString As String) As Long
Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lparam As String) As Long

Public Sub CambiarImpresora(pFichero As String)

Dim vNombre As String
Dim di As Variant
Dim L As Variant
vNombre = LeerFicheroAux(pFichero)

If vNombre <> "$$$$$$" Then

di = WriteProfileString("WINDOWS", "DEVICE", vNombre & ",winspool,Ne05")

End If


End Sub


Private Function LeerFicheroAux(NombreFichero As String) As String


Dim NumFichero As Integer

NumFichero = FreeFile

On Error GoTo error

Open NombreFichero For Input As NumFichero

LeerFicheroAux = Input(LOF(NumFichero), #NumFichero)

Close NumFichero

Exit Function

error:

If Err = 53 Then

LeerFicheroAux = "$$$$$$"

Else

MsgBox "Error de acceso, consulte con el proveedor del programa"

End If


End Function


A mi me ha funcionado utilizando datareport y cuando lo cargo vuelvo a poner la impresora predeterminda anteriormente guarda en otro fichero.

Seguramente se podra hacer más depurado, pero para lo que me hacia falta me parecio más fácil asin.

Gracias por la ayuda.

[robsergar]

Muy buena variante en la gestión de impresión!

Otras sugerencias acerca de los modulos publicados:

Cuando se crea el archivo .bas con el código de "WriteProfileString", si se desea poner la sentencia OPTION EXPLICIT, da error la constante HWND_BROADCAST, ya que no esta declarada.
Si la desea declarar, anteponer la siguiente linea al codigo del módulo:
Const HWND_BROADCAST = &HFFFF&
--------------------------------------------------------------------
Estos modulos los he modificado, y ahora realizo la gestion de las impresoras por base de datos, ya que las direcciones de las impresoras en una red y mas cuando estan conectadas a puertos USB no son las mismas. por ejemplo:

Pc1:
EpsonA: Ne01
HP1010: Ne06
HP5050: Ne04

PC2:
EpsonA: Ne02
HP1010: Ne03
HP5050: Ne01

Para seleccionar la impresora he creado una funcion, a la cual le paso como parámetro el numero del PC y el nombre de la impresora (estos datos los leo de un archivo .txt que guardo en cada PC). Luego me fijo en que puerto está conectado esta impresora a la PC indicada, y llamo a la funcion WriteProfileString con los parametros correctos.
A continuacion paso la funcion que les comento:

--------------------------------------------------------
Public Function SeleccionaImpresora(ByVal NroImpresora As Integer, nroTerminal As Integer) As Boolean
Dim di, l
SeleccionaImpresora = False
On Error GoTo ErrorImpresora
cierra datos.rsImpresora_Puerto
'Impresoras instaladas:
'1 -> HP1010
'2 -> HP1020
'3 -> HP3055
'4 -> SamSungML1740
datos.Impresora_Puerto NroImpresora, nroTerminal
If datos.rsImpresora_Puerto.RecordCount > 0 Then
'MsgBox " encontro la impresora 1"
'di = WriteProfileString("WINDOWS", "DEVICE", "HP3055,winspool,Ne02:")
'l = SendMessage(HWND_BROADCAST, WM_WININICHANGE, 0, ByVal "windows")

di = WriteProfileString("WINDOWS", "DEVICE", Trim(datos.rsImpresora_Puerto!Nombre) & ", winspool, " & Trim(datos.rsImpresora_Puerto!Puerto))
'l = SendMessageTimeout(HWND_BROADCAST, WM_WININICHANGE, 0, 0, SMTO_NORMAL, 1000, Null)

l = SendMessage(HWND_BROADCAST, WM_WININICHANGE, 0, ByVal "windows")
SeleccionaImpresora = True
Else
MsgBox "no encontro la impresora para realizar la impresión."
End If

GoTo sigue
ErrorImpresora:
'Stop

MsgBox "Error de impresion." & Chr(13) & Err.Description & Chr(13) & "Impresora:" & Trim(datos.rsImpresora_Puerto!Nombre) & vbCrLf & _
"Issue Number: " & CStr(Err.Number), vbCritical Or vbOKOnly, "Printer Manager"

sigue:
End Function

--------------------------------------------------------



Control de errores en la seleccion de las impresoras:
Cuando una impresora no se encuentre disponible por alguna circunstancia (errores producidos por mala conexion de red, etc), el objeto error toma control de este evento, permitiendo comunicar dicha situación al usuario:

Select Case Err.Number
Case 8555
MsgBox "Error de impresion." & Chr(13) & Err.Description & Chr(13) & "Impresora:" & Trim(datos.rsImpresora_Puerto!Nombre) & vbCrLf & _
"Issue Number: " & CStr(Err.Number), vbCritical Or vbOKOnly, "Printer Manager"
---------------------------------------------------------

Saludos a todos!
Sergio
Bahía Blanca

[foxtroop]

Muchas gracias Sergio!!!!!!!!

yo también llevo una semana tratando de resolver diferentes cuestiones con el "duro" del DataReport.

Y este código me va a servir mucho. Estaba buscando ejemplos con la API pero no encontraba así de claros.