Escoger fichero PDF en un formulario para visualizarlo con Procedimiento de Evento

09/05/2013 - 19:49 por Aurelio | Informe spam
Tengo un Procedimiento de Evento para seleccionar un fichero de
imagen, y visualizarlo en un formulario.

'*******************************************************************************
'* cmdAbrir_Click
'* rutina para abrir cuadro de dialogo Abrir Archivo
'* Argumentos:
'* uso:
'* KPD-Team 1998
'* ESH 02/11/03 11:35
'*******************************************************************************

Private Sub cmdAbrir_Click()
On Error GoTo cmdAbrir_Click_TratamientoErrores

Dim strArchivo As NOMBREARCHIVO

strArchivo.lStructSize = Len(strArchivo)
' establezco la ventalla llamante
strArchivo.hwndOwner = Me.Hwnd
' establezco el filtro de archivos
strArchivo.lpstrFilter = "imagenes (*.bmp, *.png, *.gif, *.tif,
*.jpg)" + Chr$(0) + "*.bmp;*.png; *.gif; *.tif; *.jpg" + Chr$(0) +
"Todos los archivos (*.*)" + Chr$(0) + "*.*" + Chr$(0)
' creo un buffer para el nombre del archivo
strArchivo.lpstrFile = Space$(254)
' establezco el tamaño máximo para el nombre del archivo
strArchivo.nMaxFile = 255
' creo un buffer para el titulo
strArchivo.lpstrFileTitle = Space$(254)
' establezco el tamaño máximo para el titulo
strArchivo.nMaxFileTitle = 255
' establezco el directorio por defecto
strArchivo.lpstrInitialDir = "C:\"
' establezco el titulo
strArchivo.lpstrTitle = "Seleccionar Imagen"
' elimino flags
strArchivo.flags = 0

' abro el cuadro de dialogo y refresco la imagen
If AbrirArchivo(strArchivo) Then
txtRuta = Trim$(strArchivo.lpstrFile)
txtRuta_AfterUpdate
Else
txtRuta = ""
End If

cmdAbrir_Click_Salir:
On Error GoTo 0
Exit Sub

cmdAbrir_Click_TratamientoErrores:

MsgBox "Error " & Err.Number & " (" & Err.Description & ") en
proc. cmdAbrir_Click de Documento VBA Form_frmImagenes"
GoTo cmdAbrir_Click_Salir

End Sub ' cmdAbrir_Click


Private Sub DataSourceControl7_Updated(Code As Integer)

End Sub



'*******************************************************************************
'* Form_Current
'* Rutina Al Activar Registro que muestra la imagen correspondiente al
registro actual
'* ESH 02/11/03 10:45
'*******************************************************************************

Private Sub Form_Current()
On Error GoTo Form_Current_TratamientoErrores

If Not IsNull(txtRuta) Then
MuestraImagen (txtRuta)
Else
Imagen.Picture = ""
End If

Form_Current_Salir:
On Error GoTo 0
Exit Sub

Form_Current_TratamientoErrores:

Call MsgBox("Error " & Err.Number & " (" & Err.Description & ") en
proc. Form_Current de Documento VBA Form_frmImagenes")
GoTo Form_Current_Salir
End Sub ' Form_Current


'*******************************************************************************
'* MuestraImagen
'* Muestra la imagen pasada como argumento
'* Argumentos: strRuta => Ruta del archivo imagen a mostrar
'* uso: MuestraImagen (Ruta)
'* ESH 02/11/03 10:43
'*******************************************************************************

Public Sub MuestraImagen(strRuta As String)

On Error GoTo MuestraImagen_TratamientoErrores

If Dir(strRuta) Then
Imagen.Picture = strRuta
Else
Err.Raise 2220
End If

MuestraImagen_Salir:
On Error GoTo 0
Exit Sub

MuestraImagen_TratamientoErrores:
Select Case Err.Number
Case 2220
Call MsgBox("La imagen no existe, comprueba que el nombre
del archivo es correcto", vbExclamation Or vbSystemModal, "ATENCION")
Case 2114
Call MsgBox("El formato de el archivo no se corresponde
con una imagen, comprueba que el nombre del archivo es correcto",
vbExclamation Or vbSystemModal, "ATENCION")
Case 2244
Call MsgBox("El archivo está vacío, comprueba que el
nombre del archivo es correcto", vbExclamation Or vbSystemModal,
"ATENCION")
Case Else
Call MsgBox("Error " & Err.Number & " (" & Err.Description
& ") en proc. MuestraImagen de Documento VBA Form_frmImagenes")
End Select

GoTo MuestraImagen_Salir
End Sub ' MuestraImagen


'*******************************************************************************
'* txtRuta_AfterUpdate
'* Rutina después de Actualizar Registro que muestra la imagen
correspondiente al
'* nuevo registro
'* ESH 02/11/03 11:02
'*******************************************************************************

Private Sub txtRuta_AfterUpdate()
On Error GoTo txtRuta_AfterUpdate_TratamientoErrores

If Not IsNull(txtRuta) Then
MuestraImagen (txtRuta)
Else
Imagen.Picture = ""
End If

txtRuta_AfterUpdate_Salir:
On Error GoTo 0
Exit Sub

txtRuta_AfterUpdate_TratamientoErrores:

MsgBox "Error " & Err.Number & " (" & Err.Description & ") en
proc. txtRuta_AfterUpdate de Documento VBA Form_frmImagenes"
GoTo txtRuta_AfterUpdate_Salir

End Sub ' txtRuta_AfterUpdate


'*******************************************************************************
'* Dir
'* Comprueba la existencia de un archivo, mejora la función dir de VBA
porque
'* esta devuelve falso si el archivo está oculto, es de sistema o solo
lectura
'* Argumentos: strArchivo => nombre del archivo buscado incluida su
ruta completa
'* uso: If Dir(strArchivo) Then
'* Juan M. Afan de Ribera
'* ESH 28/10/03 19:05
'*******************************************************************************

Public Function Dir(strArchivo) As Boolean
Dim fso As Object, _
f As Object

On Error GoTo Dir_TratamientoErrores

On Error GoTo Dir_TratamientoErrores

Set fso = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
Set f = fso.GetFile(strArchivo)

If Len(f.Path) = "" Then
Dir = False
Else
Dir = True
End If

Set fso = Nothing
Set f = Nothing

Dir_Salir:
On Error GoTo 0
Exit Function

Dir_TratamientoErrores:

MsgBox "Error " & Err.Number & " (" & Err.Description & ") en
proc. Dir de Documento VBA Form_frmImagenes"
GoTo Dir_Salir

End Function ' Dir



Private Sub viewver_Load()
'Viewer es el nombre de nuestro objeto PDF
Me.Viewer.LoadFile ("Clanes.pdf")
'Obviamente "C:\hoy.pdf" es la ruta del archivo PDF que queremos abrir
End Sub

Private Sub Viewver_Updated(Code As Integer)

End Sub
xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
Sin embargo ahora quiero adaptar dicho procedimiento para que sea
posible hacerlo con un fichero PDF.

¿Alguien podría ayudarme?

Muchas gracias.
 

Leer las respuestas

#1 Emilio
09/05/2013 - 20:13 | Informe spam
¡Importante!: Colabora con el grupo.Contesta a este mensaje y dinos si te
sirvió o no la respuesta dada. Muchas gracias
Hola!
utiliza Followhyperlink para abrir un pdf y cualquier otro tipo de documento
mediante su aplicación predeterminada.

Saludos a todos desde Huelva

Emilio [MS-MVP Access 2006/11]
http://www.mvp-access.com/foro
http://www.mvp-access.es/emilio

Preguntas similares