Cargar varias imágenes en access,
Tengo el mismo problema que tu con un temna de access al que necesito cargar varias imágenes, se que Sveinbjorn te paso una BBDD de ejemplo que te ha funcionado, pero ya no esta en el enlace. Si aun la tienes por algún sitio me vendría de maravilla para el proyecto en el que estoy
Juan: Para poder ayudarte, al menos yo tendría que saber cual es tu problema, que según veo te refieres al problema de alguien.
1.- Esas imágenes las vas mostrar en un Formulario, en un Informe.
2.- Esas imágenes las tienes en una carpeta.
Para que puedas comparar metodología te sugiero los siguientes enlaces de Web de Neckkito (un saludo maestro)>>
http://neckkito.xyz/nck/index.php/ejemplos/13-formularios/66-imagenes-en-formulario
http://neckkito.xyz/nck/index.php/ejemplos/13-formularios/67-imagenes-de-internet-en-formulario
http://neckkito.xyz/nck/index.php/ejemplos/13-formularios/91-imagenes-en-formulario-continuo
Poco más puedo decirte con lo que aportas en tu texto de la pregunta. Saludos >> JTJ
1 respuesta más de otro experto
Estuve mucho tiempo fuera en otras cosas y recién pude ingresar al foro. Claro que te puedo ayudar... Aqui te dejo el modulo y el registro en el formulario para que puedas ajustarlo a tu necesidad.
En el formulario
Option Compare Database
Private Sub Comando22_Click()
Dim misImagenes As String
Dim n As Integer
Dim laImagen As String
Dim fso As Scripting.FileSystemObject
Dim destino As String
Const carpetaFotos As String = "\Tools\Imagenes\"
misImagenes = fncBuscaImagenes
'Como yo tengo 5 controles de imagen, y la matriz empieza en 0, hay que trabajar con 4, es decir,
'con un número menos que controles imagen tengas (si tienes 10, trabajas con 9)
n = IIf(UBound(Split(misImagenes, "|")) < 4, UBound(Split(misImagenes, "|")), 4)
'Compruebas que existe la carpeta, si no la creas (hay que crear carpeta a carpeta)
If Dir(Application.CurrentProject.Path & carpetaFotos, vbDirectory) = "" Then
MkDir Application.CurrentProject.Path & "\Tools"
MkDir Application.CurrentProject.Path & carpetaFotos
End If
For i = 0 To n
Set fso = CreateObject("Scripting.FileSystemObject")
laImagen = Split(misImagenes, "|")(i)
destino = Application.CurrentProject.Path & carpetaFotos & Me.Campo1 & Format(i + 1, "000") & "." & Right(laImagen, Len(laImagen) - InStrRev(laImagen, "."))
fso.MoveFile laImagen, destino
Me.Controls("Foto" & i + 1) = Me.Campo1 & Format(i + 1, "000") & "." & Right(laImagen, Len(laImagen) - InStrRev(laImagen, "."))
Me.Controls("Imagen" & i + 1).Picture = Application.CurrentProject.Path & carpetaFotos & Me.Controls("Foto" & i + 1)
Next i
Exit Sub
For i = n + 1 To 4
Me.Controls("Foto" & i + 1) = ""
Me.Controls("Imagen" & i + 1).Picture = ""
Next i
Salida:
Exit Sub
End SubModulo
Option Compare Database '------------------------------------------------------------------------------------------------ ' Función para abrir ventana de diálogo y buscar imagenes para las Hembras y Machos '------------------------------------------------------------------------------------------------ Public Function fncBuscaImagenes() As String On Error GoTo Sol_err Dim fDialog As Office.FileDialog Dim vrtSelectedItem As Variant Set fDialog = Application.FileDialog(msoFileDialogFilePicker) With fDialog .AllowMultiSelect = True 'Esto tiene que ir en True para poder seleccionar varios archivos .ButtonName = "Seleccionar" .Title = "Seleccionar el archivo" .InitialFileName = Application.CurrentProject.Path & "\" .InitialView = msoFileDialogViewDetails .Filters.Clear .Filters.Add "Imágenes", "*.jpg; *.jpeg; *.bmp ; *.gif" If .Show = True Then For Each vrtSelectedItem In .SelectedItems 'Tienes que recorrer la colección de elementos seleccionados fncBuscaImagen = fncBuscaImagen & vrtSelectedItem & "|" Next fncBuscaImagenes = Left(fncBuscaImagen, Len(fncBuscaImagen) - 1) Else 'No hacemos nada End If End With Salida: Exit Function Sol_err: MsgBox "Se ha producido el error: " & Err.Number & " - " & Err.Description, vbInformation + vbOKOnly, "ERROR" Resume Salida End Function
Fue de gran ayuda por parte de Sveinbjorn.