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

2 respuestas

Respuesta
1

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 

http://neckkito.xyz/nck/index.php/ejemplos/13-formularios/92-imagenes-en-formulario-continuo-evolution 

Poco más puedo decirte con lo que aportas en tu texto de la pregunta. Saludos >> JTJ

Respuesta
1

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 Sub

Modulo

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.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas