No funciona abrir diálogo para elegir una foto
Tengo una base de datos en la que no funciona un botón para seleccionar imágenes.
A ver, es una base de datos que hizo mi padre allá por los principios del siglo XXI, y sin tener ni idea de VBA. Y claro, al no haber hecho yo la base de datos, y mi padre haber metido el posible código de VBA que hiciera falta mediante macros, pues eso, me da miedico tocarla, porque no conozco cómo está hecha, y liarla parda.
2 Respuestas
Para abrir la imagen, utiliza este módulo:
https://www.dropbox.com/s/s5iqiodwbxefre3/M%C3%B3dulo1.bas?dl=0
Y lo llama desde el formulario tal que así:
Private Sub Comando4_Click() iUbicacion.SetFocus Dim s As String s = OpenCommDlg() If s <> "" Then iUbicacion = s iUbicacion_AfterUpdate End If End Sub
Entonces, aquí mi duda es saber qué está fallando. Ambos tenemos Office 2016 de 64 bits.
Yo podría meterle un código más simple, pero como decía, no sé si hay más formularios donde añada imágenes, cómo lo hace... Y, sinceramente, no quiero enfrascarme en limpiar una base de datos porque no tengo tiempo para ello. Busco algo rápido y sencillo, que es también lo que quiere mi padre, ya que no quiere rehacer la base de datos (le entiendo, yo tampoco querría).
Nada más.
Diego: Bote pronto y sin un análisis detallado, las variables de VBA y Win64 cambian algunas a LongTpr. Las API evidentemente cambian, pero creo que ya lo has hecho.
Debe quedar así: Supongo te daría un Error de no coincidencia de tipos.
#IfVBA7 And Win64 Then Type tagOPENFILENAME lStructSize As Long hwndOwner As LongPtr hInstance As LongPtr lpstrFilter As String lpstrCustomFilter As String nMaxCustFilter As Long nFilterIndex As Long lpstrFile As String nMaxFile As Long lpstrFileTitle As String nMaxFileTitle As Long lpstrInitialDir As String lpstrTitle As String flags As Long nFileOffset As Integer nFileExtension As Integer lpstrDefExt As String lCustData As LongPtr lpfnHook As LongPtr lpTemplateName As String '#if (_WIN32_WINNT >= 0x0500) pvReserved As LongPtr dwReserved As Long FlagsEx As Long '#endif // (_WIN32_WINNT > End Type #Else Type tagOPENFILENAME lStructSize As Long hwndOwner As Long hInstance As Long lpstrFilter As String lpstrCustomFilter As String nMaxCustFilter As Long nFilterIndex As Long lpstrFile As String nMaxFile As Long lpstrFileTitle As String nMaxFileTitle As Long lpstrInitialDir As String lpstrTitle As String flags As Long nFileOffset As Integer nFileExtension As Integer lpstrDefExt As String lCustData As Long lpfnHook As Long lpTemplateName As String End Type #End If
Ignoro si en la Función habrá que tocar algo. Un saludo >> JTJ
Hola, Jacinto, muchas gracias, pero pego el código y sigue sin funcionar.
No entiendo esto:
las variables de VBA y Win64 cambian algunas a LongTpr. Las API evidentemente cambian, pero creo que ya lo has hecho
Estoy mirando el código del módulo y no veo ningún LongTpr. Y si las API cambian y lo he hecho yo, pues no te digo yo que no, porque el otro día le daba un error en el mismo módulo y ningún botón de la base de datos funcionaba. Buscando le cambié esto:
Declare Function apiGetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (OPENFILENAME As tagOPENFILENAME) As Long
a lo que has visto en el módulo que he adjuntado.
Esto es lo que hay en el formulario:
Private Sub Comando4_Click() iUbicacion.SetFocus Dim s As String s = OpenCommDlg() If s <> "" Then iUbicacion = s iUbicacion_AfterUpdate End If End Sub Private Sub Form_Current() iUbicacion_AfterUpdate End Sub Private Sub iUbicacion_AfterUpdate() If Not IsNull(iUbicacion) Then Imagen3.Picture = iUbicacion Else Imagen3.Picture = "" End If End Sub
Yo no veo nada raro aquí.
Diego: Si te fijas en el bloque te tagOPENFILENAME verás que >> hwndOwner As LongPtr
Supongo que además de copiar y pegar esos dos bloques has borrado el Bloque que había de >>
Type tagOPENFILENAME.
Aparte de eso yo tengo un Error al principio : #IfVBA7.. debe ser #If VBA7.. separando el If
La solución drástica, ya la sabes... Pasarte a otra metodología de la cual sabes que hay ejemplos en la Web de Neckkito.
Mira si te da algún error concreto y la línea de código. Saludos >> JTJ
Así es como lo he dejado:
https://www.dropbox.com/s/62cikmye0smkr58/M%C3%B3dulo1.bas?dl=0
y me da error en esta línea
If apiGetOpenFileName(OPENFILENAME) <> 0 Then OpenCommDlg = Left$(OPENFILENAME.lpstrFile, InStr(OPENFILENAME.lpstrFile, Chr$(0)) - 1) Else OpenCommDlg = "" End If
Y por cambiar, yo tengo ejemplos en varias bases de datos, pero lo que no quiero enfrascarme en algo muy gordo.
Por probar otra cosita más no te va a consumir mucho tiempo.
1.- Quita el $ del Lef$ >> Haz la prueba si va nada más
Jacinto
El error que me da es que no se ha definido apiGetOpenFileName, así que le he metido estas líneas
#If Win64 And VBA7 Then Private Declare PtrSafe Function apiGetOpenFileName Lib "comdlg32.dll" _ Alias "GetOpenFileNameA" (OPENFILENAME As tagOPENFILENAME) As Long #Else Private Declare Function apiGetOpenFileName Lib "comdlg32.dll" _ Alias "GetOpenFileNameA" (OPENFILENAME As tagOPENFILENAME) As Long #End If
y le he quitado el $.
Me parece que no estoy definiendo bien la función.
Sinceramente no veo la raíz del error. Miro mañana porque ésta noche ya es tarde, de dedicar un rato a ver si se me ocurre algo. Saludos >> Jacinto
Ok, gracias. Si necesitaras la base de datos, me lo dices. Un saludo.
Diego: Mejor me envías la Base de datos y las pruebas las voy haciendo directas.
Un saludo >> Jacinto