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