Imprimir página | Cerrar ventana

No se abre cuadro dialogo para elegir foto

Impreso de: Foro de Access y VBA
Categoría: Access y VBA
Nombre del foro: Access y VBA
Descripción del foro: Foro de programacion en Access (Con código y sin código)
URL: http://www.mvp-access.com/foro/forum_posts.asp?TID=86681
Fecha de impresión: 27/Marzo/2026 a las 06:10


Tema: No se abre cuadro dialogo para elegir foto
Publicado por: isaias
Asunto: No se abre cuadro dialogo para elegir foto
Fecha de publicación: 09/Mayo/2023 a las 13:02
Buenos dias.
Sigo con mis problemas de migracion de access 2003 a 2019.
Tengo un formulario de articulos con un icono que al pulsar me abria el cuadro de dialogo de windows para seleccionar la imagen de un articulo y traerme la ruta para mostrarla en el formulario, pero ahora resulta no me abre el cuadro de dialogo.

Muestro el codigo que tengo puesto:
Private Sub Comando4_Click()
' ------------------------
' ICONO QUE AL PULSAR
' SALE EL EXPLORADOR PARA
' BUSCAR LA IMAGEN
' ------------------------
' iUbicacion = ruta    -> cuadro de texto que aloja la ruta
' Imagen3    = cfoto   -> cuadro de imagen en la que se ve la imagen
' Comando4   = icono camara de fotos -> abre el explorador para buscar la imagen

Dim s As String
    ruta.SetFocus
    s = OpenCommDlg()
    If s <> "" Then
        ruta = s
        ruta_AfterUpdate
    End If
End Sub

Este es el móculo

'-------------------------------------------------------
' Open Common Dialog Function
'-------------------------------------------------------
Function OpenCommDlg()
Dim Message$, Filter$, FileName$, FileTitle$, DefExt$
Dim Title$, szCurDir$, APIResults&
'
Filter$ = "Imágenes (GIF,PCX,BMP,JPG,JPEG,PNG)" & Chr$(0) & "*.BMP;*.GIF;*.PCX;*.JPG;*.JPEG;*.PNG;" & Chr$(0) & _
        "Todos los ficheros (*.*)" & Chr(0) & "*.*;" & Chr(0)
Filter$ = Filter$ & Chr$(0)
'
FileName$ = Chr$(0) & Space$(255) & Chr$(0)
FileTitle$ = Space$(255) & Chr$(0)
'* Give the dialog a caption title.
Title$ = "Seleccionar imagen" & Chr$(0)
'
DefExt$ = "BMP" & Chr$(0)   ' extensión por defecto
szCurDir$ = CurDir$ & Chr$(0)  ' directorio por defecto, el actual
'* Set up the data structure before you call the GetOpenFileName
OPENFILENAME.lStructSize = Len(OPENFILENAME)
'If the OpenFile Dialog box is linked to a form use this line.
'It will pass the forms window handle.
OPENFILENAME.hwndOwner = Screen.ActiveForm.hwnd
'If the OpenFile Dialog box is not linked to any form use this line.
'It will pass a null pointer.
'OPENFILENAME.hwndOwner = 0&
OPENFILENAME.lpstrFilter = Filter$
OPENFILENAME.nFilterIndex = 1
OPENFILENAME.lpstrFile = FileName$
OPENFILENAME.nMaxFile = Len(FileName$)
OPENFILENAME.lpstrFileTitle = FileTitle$
OPENFILENAME.nMaxFileTitle = Len(FileTitle$)
OPENFILENAME.lpstrTitle = Title$
OPENFILENAME.flags = OFN_FILEMUSTEXIST Or OFN_READONLY Or OFN_PATHMUSTEXIST Or OFN_FILEMUSTEXIST
OPENFILENAME.lpstrDefExt = DefExt$
OPENFILENAME.hInstance = 0
OPENFILENAME.lpstrCustomFilter = String(255, 0)
OPENFILENAME.nMaxCustFilter = 255
OPENFILENAME.lpstrInitialDir = szCurDir$
OPENFILENAME.nFileOffset = 0
OPENFILENAME.nFileExtension = 0
OPENFILENAME.lCustData = 0
OPENFILENAME.lpfnHook = 0
OPENFILENAME.lpTemplateName = 0
If apiGetOpenFileName(OPENFILENAME) <> 0 Then
    OpenCommDlg = Left$(OPENFILENAME.lpstrFile, InStr(OPENFILENAME.lpstrFile, Chr$(0)) - 1)
Else
    OpenCommDlg = ""
End If
End Function

Gracias por anticipado


-------------
Por más difícil que se nos presente una situación, nunca dejemos de buscar la salida ni de luchar hasta el último momento. Albert Einstein



Respuestas:
Publicado por: emiliove
Fecha de publicación: 09/Mayo/2023 a las 15:19
Para abrir un cuadro de dialogo de archivo tenemos la propiedad fileDialog mira como se usa:  https://learn.microsoft.com/es-es/office/vba/api/access.application.filedialog" rel="nofollow - https://learn.microsoft.com/es-es/office/vba/api/access.application.filedialog

Saludos.


Publicado por: isaias
Fecha de publicación: 09/Mayo/2023 a las 19:32
Lo primero gracias por tu interes emiliave.

Enumero primero que mi sistema es windows 10 - 64 bits con office 2019.

Si tengo que decir que mis conocimientos de vba son muy limitados, pero que gracias a este foro y otros compañeros he conseguido crearme una base de datos personal para la gestion de mi negocio.

Ahora al grano, copio el codigo del enlace que pone y me sale ERROR DE COMPILACION: NO SE HA DEFINIDO EL TIPO DEFINIDO ....

En el codigo pone que necesita  ' Requires reference to Microsoft Office 11.0 Object Library.
He buscado en las referencias de VBA y no me aparece esta referencia.

Sigo a merced de tu sabiduria, haber si avanzo.

Gracias



-------------
Por más difícil que se nos presente una situación, nunca dejemos de buscar la salida ni de luchar hasta el último momento. Albert Einstein


Publicado por: 01loko
Fecha de publicación: 09/Mayo/2023 a las 19:49
en mi corto conocimiento cuando te dice "Microsoft Office 11.0 Object Library." se refiere a la librería office versión que tengas instalada, sea 11 o superior



-------------
Recordar de que soy nuevo y estoy aprendiendo.


Publicado por: isaias
Fecha de publicación: 09/Mayo/2023 a las 19:57
Publicado originalmente por 01loko 01loko escribió:

en mi corto conocimiento cuando te dice "Microsoft Office 11.0 Object Library." se refiere a la librería office versión que tengas instalada, sea 11 o superior

Gracias por tu interes, he revisado eso y tengo activada la Microsoft Office 16.0

Un saludo


-------------
Por más difícil que se nos presente una situación, nunca dejemos de buscar la salida ni de luchar hasta el último momento. Albert Einstein


Publicado por: isaias
Fecha de publicación: 09/Mayo/2023 a las 20:01
Publicado originalmente por 01loko 01loko escribió:

en mi corto conocimiento cuando te dice "Microsoft Office 11.0 Object Library." se refiere a la librería office versión que tengas instalada, sea 11 o superior


PERDONNNNNNNNNNN

No la tenia activada, acabo de hacerla, lo siento muchisimo

Un saludo


-------------
Por más difícil que se nos presente una situación, nunca dejemos de buscar la salida ni de luchar hasta el último momento. Albert Einstein


Publicado por: isaias
Fecha de publicación: 11/Mayo/2023 a las 13:33
Bueno por fin acabo de conseguirlo, y mira que me ha costado pero gracias a emiliove y 01loko, que me han orientado ya esta corregido y funcionando. Y como no a san google.
Comparto el codigo por si a algun compañero en el futuro le es neceario:

Private Sub cmdCamaraFotos_Click()
' ------------------------
' ICONO QUE AL PULSAR
' SALE EL EXPLORADOR PARA
' BUSCAR LA IMAGEN
' ------------------------
' iUbicacion = ruta    -> cuadro de texto que aloja la ruta
' Imagen3    = cfoto   -> cuadro de imagen en la que se ve la imagen
' cmdCamaraFotos = icono camara de fotos -> abre el explorador para buscar la imagen
Dim s As String
    ruta.SetFocus
    s = buscaArchivo()
    If s <> "" Then
        ruta = s
        ruta_AfterUpdate
    End If
End Sub

Public Function buscaArchivo() As String
    ' FUNCION QUE ABRE EL CUADRO DE DIALOGO PARA ELEGIR IMAGENES
Dim fDialog As Office.FileDialog
Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
With fDialog
    .AllowMultiSelect = False
    .ButtonName = "Seleccionar un imagen"
    .Title = "Seleccionar el archivo"
    .InitialFileName = "\\******\******\" '---> Aqui esta indicada la ruta inicial del cuadro de dialogo
    .InitialView = msoFileDialogViewDetails
    .Filters.Clear
    .Filters.Add "Tipos de Imagenes: ", "*.jpg; *.jpeg; *.bmp; *.gif", 1
    .Filters.Add "All Files", "*.*"
    If .Show = True Then
        buscaArchivo = .SelectedItems(1)
    Else
        MsgBox "Ha pulsado el botón <CANCELAR>."
    End If
End With
End Function

Gracias a todos los que me han ayudado. Hasta la próxima

Pueden cerrar el hilo, un saludo


-------------
Por más difícil que se nos presente una situación, nunca dejemos de buscar la salida ni de luchar hasta el último momento. Albert Einstein



Imprimir página | Cerrar ventana