Automatizar duplex para imprimir a doble cara

16/11/2006 - 11:07 por kusflo | Informe spam
Necesito crear una macro que me permita imprimir a doble cara los documentos.
Luego le asignaría dicha macro a un botón.

En un principio crei que sería tan sencillo como "grabar macro" e ir
haciéndolo manualmente hasta imprimir las hojas y posteriormente parar la
macro. Pero al comprobar el código generado en la grabación me he dado cuenta
que la macro no graba cuando configuro la impresora a duplex. He probado con
varias impresoras y no lo graba en ninguna. ¿¿Hay alguna forma de
conseguirlo??
"Saber que se sabe lo que se sabe y que no se sabe lo que no se sabe; he
aquí el verdadero saber." Confucio.

Preguntas similare

Leer las respuestas

#1 Marta PM
16/11/2006 - 11:17 | Informe spam
Hola:
Supongo que sí habrá forma de conseguirlo pero como solución rápida se me ocurre que
crees una copia de tu impresora, le asignes las propiedades que quieres y luego un
nombre diferente y en la macro de Word uses esa impresora.

Marta PM
Saúdos/Saludos
MVP Office

(Si quieres escribirme ya sabes lo que no quiero)
Más consejos en www.fermu.com
__________
La información contenida en este mensaje se proporciona "TAL CUAL", sin garantías
explícitas ni implícitas, y no otorga derecho alguno. Usted asume cualquier riesgo al
poner en práctica lo recomendado o sugerido en el presente mensaje.

¿Quieres saber que es un MVP?
http://mvp.support.microsoft.com/

"kusflo" (donotspam)> escribió en el mensaje
news:
Necesito crear una macro que me permita imprimir a doble cara los documentos.
Luego le asignaría dicha macro a un botón.

En un principio crei que sería tan sencillo como "grabar macro" e ir
haciéndolo manualmente hasta imprimir las hojas y posteriormente parar la
macro. Pero al comprobar el código generado en la grabación me he dado cuenta
que la macro no graba cuando configuro la impresora a duplex. He probado con
varias impresoras y no lo graba en ninguna. ¿¿Hay alguna forma de
conseguirlo??
"Saber que se sabe lo que se sabe y que no se sabe lo que no se sabe; he
aquí el verdadero saber." Confucio.
Respuesta Responder a este mensaje
#2 kusflo
16/11/2006 - 11:35 | Informe spam
Gracias por la respuesta. Es una solución aceptable pero me obligaría a crear
el doble de impresoras y no me termina de gustar. Me parece bastante raro que
no exista una propiedad que envie una orden tan común como "doble cara"
directamente a la impresora.
También pense en grabar las pulsaciones de teclas que utilizo para
configurar la impresora y posteriormente ponerlas en la macro. Así
conseguiría configurar la impresora automáticamente pero tampoco me parece
una solucion "elegante" (como diría Greg House). Con lo cual agradezco tú
aportación pero sigo a la caza de una solución más ... "elegante" :-)
Agradezco nuevamente la aportación pero sigo buscando una solución mejor.
"Saber que se sabe lo que se sabe y que no se sabe lo que no se sabe; he
aquí el verdadero saber." Confucio.
Respuesta Responder a este mensaje
#3 Marta PM
16/11/2006 - 11:54 | Informe spam
Revisa estos enlaces:
http://pubs.logicalexpressions.com/...cle.asp?ID1
http://pubs.logicalexpressions.com/...cle.asp?ID6
http://support.microsoft.com/?kbid#0743
http://support.microsoft.com/kb/828638

Suerte!!!
Marta PM
Saúdos/Saludos
MVP Office

(Si quieres escribirme ya sabes lo que no quiero)
Más consejos en www.fermu.com
__________
La información contenida en este mensaje se proporciona "TAL CUAL", sin garantías
explícitas ni implícitas, y no otorga derecho alguno. Usted asume cualquier riesgo al
poner en práctica lo recomendado o sugerido en el presente mensaje.

¿Quieres saber que es un MVP?
http://mvp.support.microsoft.com/

"kusflo" (donotspam)> escribió en el mensaje
news:
Gracias por la respuesta. Es una solución aceptable pero me obligaría a crear
el doble de impresoras y no me termina de gustar. Me parece bastante raro que
no exista una propiedad que envie una orden tan común como "doble cara"
directamente a la impresora.
También pense en grabar las pulsaciones de teclas que utilizo para
configurar la impresora y posteriormente ponerlas en la macro. Así
conseguiría configurar la impresora automáticamente pero tampoco me parece
una solucion "elegante" (como diría Greg House). Con lo cual agradezco tú
aportación pero sigo a la caza de una solución más ... "elegante" :-)
Agradezco nuevamente la aportación pero sigo buscando una solución mejor.
"Saber que se sabe lo que se sabe y que no se sabe lo que no se sabe; he
aquí el verdadero saber." Confucio.

Respuesta Responder a este mensaje
#4 kusflo
16/11/2006 - 13:37 | Informe spam
Para el que le interese dejo una solución larga pero "elegante". Sólo hay que
copiar todo el código en un módulo de word y asignar a un botón la macro
"Imprimir_Duplex" situada al final de todo:

Option Explicit

Private Type PRINTER_DEFAULTS
pDatatype As Long
pDevmode As Long
DesiredAccess As Long
End Type

Private Type PRINTER_INFO_2
pServerName As Long
pPrinterName As Long
pShareName As Long
pPortName As Long
pDriverName As Long
pComment As Long
pLocation As Long
pDevmode As Long ' Pointer to DEVMODE
pSepFile As Long
pPrintProcessor As Long
pDatatype As Long
pParameters As Long
pSecurityDescriptor As Long ' Pointer to SECURITY_DESCRIPTOR
Attributes As Long
Priority As Long
DefaultPriority As Long
StartTime As Long
UntilTime As Long
Status As Long
cJobs As Long
AveragePPM As Long
End Type

Private Type DEVMODE
dmDeviceName As String * 32
dmSpecVersion As Integer
dmDriverVersion As Integer
dmSize As Integer
dmDriverExtra As Integer
dmFields As Long
dmOrientation As Integer
dmPaperSize As Integer
dmPaperLength As Integer
dmPaperWidth As Integer
dmScale As Integer
dmCopies As Integer
dmDefaultSource As Integer
dmPrintQuality As Integer
dmColor As Integer
dmDuplex As Integer
dmYResolution As Integer
dmTTOption As Integer
dmCollate As Integer
dmFormName As String * 32
dmUnusedPadding As Integer
dmBitsPerPel As Integer
dmPelsWidth As Long
dmPelsHeight As Long
dmDisplayFlags As Long
dmDisplayFrequency As Long
dmICMMethod As Long
dmICMIntent As Long
dmMediaType As Long
dmDitherType As Long
dmReserved1 As Long
dmReserved2 As Long
End Type

Private Const DM_ORIENTATION = &H1
Private Const DM_PAPERSIZE = &H2
Private Const DM_PAPERLENGTH = &H4
Private Const DM_PAPERWIDTH = &H8
Private Const DM_DEFAULTSOURCE = &H200
Private Const DM_PRINTQUALITY = &H400
Private Const DM_COLOR = &H800
Private Const DM_DUPLEX = &H1000

Private Const DM_IN_BUFFER = 8
Private Const DM_OUT_BUFFER = 2
Private Const PRINTER_ACCESS_USE = &H8
Private Const STANDARD_RIGHTS_REQUIRED = &HF0000
Private Const PRINTER_NORMAL_ACCESS = (STANDARD_RIGHTS_REQUIRED Or _
PRINTER_ACCESS_USE)

Private Const PRINTER_ENUM_CONNECTIONS = &H4
Private Const PRINTER_ENUM_LOCAL = &H2

Private Declare Function ClosePrinter Lib "winspool.drv" _
(ByVal hPrinter As Long) As Long
Private Declare Function DocumentProperties Lib "winspool.drv" _
Alias "DocumentPropertiesA" (ByVal hwnd As Long, _
ByVal hPrinter As Long, ByVal pDeviceName As String, _
ByVal pDevModeOutput As Long, ByVal pDevModeInput As Long, _
ByVal fMode As Long) As Long
Private Declare Function GetPrinter Lib "winspool.drv" Alias _
"GetPrinterA" (ByVal hPrinter As Long, ByVal Level As Long, _
pPrinter As Byte, ByVal cbBuf As Long, pcbNeeded As Long) As Long
Private Declare Function OpenPrinter Lib "winspool.drv" Alias _
"OpenPrinterA" (ByVal pPrinterName As String, phPrinter As Long, _
pDefault As PRINTER_DEFAULTS) As Long
Private Declare Function SetPrinter Lib "winspool.drv" Alias _
"SetPrinterA" (ByVal hPrinter As Long, ByVal Level As Long, _
pPrinter As Byte, ByVal Command As Long) As Long
Private Declare Function EnumPrinters Lib "winspool.drv" _
Alias "EnumPrintersA" _
(ByVal flags As Long, ByVal name As String, ByVal Level As Long, _
pPrinterEnum As Long, ByVal cdBuf As Long, pcbNeeded As Long, _
pcReturned As Long) As Long

Private Declare Function PtrToStr Lib "kernel32" Alias "lstrcpyA" _
(ByVal RetVal As String, ByVal Ptr As Long) As Long

Private Declare Function StrLen Lib "kernel32" Alias "lstrlenA" _
(ByVal Ptr As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
(pDest As Any, pSource As Any, ByVal cbLength As Long)
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Private Declare Function DeviceCapabilities Lib "winspool.drv" _
Alias "DeviceCapabilitiesA" (ByVal lpDeviceName As String, _
ByVal lpPort As String, ByVal iIndex As Long, lpOutput As Any, _
ByVal dev As Long) As Long

Public Sub SetColorMode(iColorMode As Long)
SetPrinterProperty DM_COLOR, iColorMode
End Sub

Public Function GetColorMode() As Long
GetColorMode = GetPrinterProperty(DM_COLOR)
End Function

Public Sub SetDuplex(iDuplex As Long)
SetPrinterProperty DM_DUPLEX, iDuplex
End Sub

Public Function GetDuplex() As Long
GetDuplex = GetPrinterProperty(DM_DUPLEX)
End Function

Public Sub SetPrintQuality(iQuality As Long)
SetPrinterProperty DM_PRINTQUALITY, iQuality
End Sub

Public Function GetPrintQuality() As Long
GetPrintQuality = GetPrinterProperty(DM_PRINTQUALITY)
End Function

Private Function SetPrinterProperty(ByVal iPropertyType As Long, _
ByVal iPropertyValue As Long) As Boolean

'Code adapted from Microsoft KB article Q230743

Dim hPrinter As Long 'handle for the current printer
Dim pd As PRINTER_DEFAULTS
Dim pinfo As PRINTER_INFO_2
Dim dm As DEVMODE
Dim sPrinterName As String

Dim yDevModeData() As Byte 'Byte array to hold contents
'of DEVMODE structure
Dim yPInfoMemory() As Byte 'Byte array to hold contents
'of PRINTER_INFO_2 structure
Dim iBytesNeeded As Long
Dim iRet As Long
Dim iJunk As Long
Dim iCount As Long

On Error GoTo cleanup

'Get the name of the current printer
sPrinterName = Trim$(Left$(ActivePrinter, _
InStr(ActivePrinter, " on ")))

pd.DesiredAccess = PRINTER_NORMAL_ACCESS
iRet = OpenPrinter(sPrinterName, hPrinter, pd)
If (iRet = 0) Or (hPrinter = 0) Then
'Can't access current printer. Bail out doing nothing
Exit Function
End If

'Get the size of the DEVMODE structure to be loaded
iRet = DocumentProperties(0, hPrinter, sPrinterName, 0, 0, 0)
If (iRet < 0) Then
'Can't access printer properties.
GoTo cleanup
End If

'Make sure the byte array is large enough
'Some printer drivers lie about the size of the DEVMODE structure they
'return, so an extra 100 bytes is provided just in case!
ReDim yDevModeData(0 To iRet + 100) As Byte

'Load the byte array
iRet = DocumentProperties(0, hPrinter, sPrinterName, _
VarPtr(yDevModeData(0)), 0, DM_OUT_BUFFER)
If (iRet < 0) Then
GoTo cleanup
End If

'Copy the byte array into a structure so it can be manipulated
Call CopyMemory(dm, yDevModeData(0), Len(dm))

If dm.dmFields And iPropertyType = 0 Then
'Wanted property not available. Bail out.
GoTo cleanup
End If

'Set the property to the appropriate value
Select Case iPropertyType
Case DM_ORIENTATION
dm.dmOrientation = iPropertyValue
Case DM_PAPERSIZE
dm.dmPaperSize = iPropertyValue
Case DM_PAPERLENGTH
dm.dmPaperLength = iPropertyValue
Case DM_PAPERWIDTH
dm.dmPaperWidth = iPropertyValue
Case DM_DEFAULTSOURCE
dm.dmDefaultSource = iPropertyValue
Case DM_PRINTQUALITY
dm.dmPrintQuality = iPropertyValue
Case DM_COLOR
dm.dmColor = iPropertyValue
Case DM_DUPLEX
dm.dmDuplex = iPropertyValue
End Select

'Load the structure back into the byte array
Call CopyMemory(yDevModeData(0), dm, Len(dm))

'Tell the printer about the new property
iRet = DocumentProperties(0, hPrinter, sPrinterName, _
VarPtr(yDevModeData(0)), VarPtr(yDevModeData(0)), _
DM_IN_BUFFER Or DM_OUT_BUFFER)

If (iRet < 0) Then
GoTo cleanup
End If

'The code above *ought* to be sufficient to set the property
'correctly. Unfortunately some brands of Postscript printer don't
'seem to respond correctly. The following code is used to make
'sure they also respond correctly.
Call GetPrinter(hPrinter, 2, 0, 0, iBytesNeeded)
If (iBytesNeeded = 0) Then
'Couldn't access shared printer settings
GoTo cleanup
End If

'Set byte array large enough for PRINTER_INFO_2 structure
ReDim yPInfoMemory(0 To iBytesNeeded + 100) As Byte

'Load the PRINTER_INFO_2 structure into byte array
iRet = GetPrinter(hPrinter, 2, yPInfoMemory(0), iBytesNeeded, iJunk)
If (iRet = 0) Then
'Couldn't access shared printer settings
GoTo cleanup
End If

'Copy byte array into the structured type
Call CopyMemory(pinfo, yPInfoMemory(0), Len(pinfo))

'Load the DEVMODE structure with byte array containing
'the new property value
pinfo.pDevmode = VarPtr(yDevModeData(0))

'Set security descriptor to null
pinfo.pSecurityDescriptor = 0

'Copy the PRINTER_INFO_2 structure back into byte array
Call CopyMemory(yPInfoMemory(0), pinfo, Len(pinfo))

'Send the new details to the printer
iRet = SetPrinter(hPrinter, 2, yPInfoMemory(0), 0)

'Indicate whether it all worked or not!
SetPrinterProperty = CBool(iRet)

cleanup:
'Release the printer handle
If (hPrinter <> 0) Then Call ClosePrinter(hPrinter)

'Flush the message queue. If you don't do this,
'you can get page fault errors when you try to
'print a document immediately after setting a printer property.
For iCount = 1 To 20
DoEvents
Next iCount
End Function

Private Function GetPrinterProperty(ByVal iPropertyType As Long) As Long

'Code adapted from Microsoft KB article Q230743

Dim hPrinter As Long
Dim pd As PRINTER_DEFAULTS
Dim dm As DEVMODE
Dim sPrinterName As String

Dim yDevModeData() As Byte
Dim iRet As Long

On Error GoTo cleanup

'Get the name of the current printer
sPrinterName = Trim$(Left$(ActivePrinter, _
InStr(ActivePrinter, " on ")))

pd.DesiredAccess = PRINTER_NORMAL_ACCESS

'Get the printer handle
iRet = OpenPrinter(sPrinterName, hPrinter, pd)
If (iRet = 0) Or (hPrinter = 0) Then
'Couldn't access the printer
Exit Function
End If

'Find out how many bytes needed for the printer properties
iRet = DocumentProperties(0, hPrinter, sPrinterName, 0, 0, 0)
If (iRet < 0) Then
'Couldn't access printer properties
GoTo cleanup
End If

'Make sure the byte array is large enough, including the
'100 bytes extra in case the printer driver is lying.
ReDim yDevModeData(0 To iRet + 100) As Byte

'Load the printer properties into the byte array
iRet = DocumentProperties(0, hPrinter, sPrinterName, _
VarPtr(yDevModeData(0)), 0, DM_OUT_BUFFER)
If (iRet < 0) Then
'Couldn't access printer properties
GoTo cleanup
End If



'Copy the byte array to the DEVMODE structure
Call CopyMemory(dm, yDevModeData(0), Len(dm))

If Not dm.dmFields And iPropertyType = 0 Then
'Requested property not available on this printer.
GoTo cleanup
End If

'Get the value of the requested property
Select Case iPropertyType
Case DM_ORIENTATION
GetPrinterProperty = dm.dmOrientation
Case DM_PAPERSIZE
GetPrinterProperty = dm.dmPaperSize
Case DM_PAPERLENGTH
GetPrinterProperty = dm.dmPaperLength
Case DM_PAPERWIDTH
GetPrinterProperty = dm.dmPaperWidth
Case DM_DEFAULTSOURCE
GetPrinterProperty = dm.dmDefaultSource
Case DM_PRINTQUALITY
GetPrinterProperty = dm.dmPrintQuality
Case DM_COLOR
GetPrinterProperty = dm.dmColor
Case DM_DUPLEX
GetPrinterProperty = dm.dmDuplex
End Select

cleanup:
'Release the printer handle
If (hPrinter <> 0) Then Call ClosePrinter(hPrinter)

End Function

Sub Imprimir_Duplex()

Dim iDuplex As Long

iDuplex = GetDuplex 'salva la configuracion de impresora actual
SetDuplex 2 'duplex para documentos verticales
ActiveDocument.PrintOut Background:=False 'Imprimimos
SetDuplex iDuplex 'devolvemos la configuracion original

End Sub

"Saber que se sabe lo que se sabe y que no se sabe lo que no se sabe; he
aquí el verdadero saber." Confucio.
Respuesta Responder a este mensaje
#5 Marta PM
16/11/2006 - 14:12 | Informe spam
Gracias por compartir la solución.

Marta PM
Saúdos/Saludos
MVP Office

(Si quieres escribirme ya sabes lo que no quiero)
Más consejos en www.fermu.com
__________
La información contenida en este mensaje se proporciona "TAL CUAL", sin garantías
explícitas ni implícitas, y no otorga derecho alguno. Usted asume cualquier riesgo al
poner en práctica lo recomendado o sugerido en el presente mensaje.

¿Quieres saber que es un MVP?
http://mvp.support.microsoft.com/

"kusflo" (donotspam)> escribió en el mensaje
news:
Para el que le interese dejo una solución larga pero "elegante". Sólo hay que
copiar todo el código en un módulo de word y asignar a un botón la macro
"Imprimir_Duplex" situada al final de todo:

Option Explicit

"Saber que se sabe lo que se sabe y que no se sabe lo que no se sabe; he
aquí el verdadero saber." Confucio.

email Siga el debate Respuesta Responder a este mensaje
Ads by Google
Help Hacer una preguntaRespuesta Tengo una respuesta
Search Busqueda sugerida