Ver Mensaje Individual
  #3 (permalink)  
Antiguo 15/04/2009, 01:03
xansuy
 
Fecha de Ingreso: abril-2009
Mensajes: 3
Antigüedad: 15 años, 1 mes
Puntos: 0
Respuesta: Imprimir pdf desde vb

Dim Resultado As Variant

' enviamos el fichero a la impresora
Resultado = PrintFile("c:\MiFichero.pdf")
If Resultado = True Then
MsgBox "El documento se envió a la impresora"
Else
MsgBox Resultado
End If

'---------------------------------------------------------
'
' PrintFile
'
' Código escrito originalmente por Francisco Javier García
' Aguado (Búho)
' Estás autorizado a utilizarlo dentro de una aplicación
' siempre que esta nota de autor permanezca inalterada.
' En el caso de querer publicarlo en una página Web,
' por favor, contactar con el autor en
'
' [email protected]
'
' Este código se brinda por cortesía de
' Francisco Javier García Aguado (Búho)
'
Private Declare Function ShellExecute Lib "shell32.dll" _
Alias "ShellExecuteA" _
(ByVal hwnd As Long, _
ByVal lpOperation As String, _
ByVal lpFile As String, _
ByVal lpParameters As String, _
ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As Long

Private Declare Function FormatMessage Lib "kernel32" _
Alias "FormatMessageA" _
(ByVal dwFlags As Long, _
lpSource As Any, _
ByVal dwMessageId As Long, _
ByVal dwLanguageId As Long, _
ByVal lpBuffer As String, _
ByVal nSize As Long, _
Arguments As Long) As Long

Private Const SW_HIDE = 0&
Private Const FORMAT_MESSAGE_FROM_SYSTEM = &H1000

' función que imprime un documento de cualquier aplicación
Public Function PrintFile(FileName As String) As Variant
Dim RetVal As Long
Dim sError As String
Dim LenMsg As Long

' se manda imprimir el documento
RetVal = ShellExecute(0&, "print", FileName, 0&, vbNullString, SW_HIDE)

' si se ha producido algún error
If RetVal < 33 Then
sError = Space(1024)
' obtenemos el mensaje de error que manda el sistema
LenMsg = FormatMessage( _
FORMAT_MESSAGE_FROM_SYSTEM, _
ByVal 0&, _
RetVal, _
0&, _
sError, _
Len(sError), _
0&)
' devolvemos el mensaje de error
PrintFile = Left(sError, LenMsg - 1)
Else
' la función tuvo éxito
PrintFile = True
End If

End Function
'---------------------------------------------------------