EXCELeINFO

Formulario de alta y búsqueda de registros incluyendo imágenes en Excel

by · 16 April, 2014

Formularios de Alta y Búsqueda de registros incluyendo imágenes en Excel usando VBA y macros

Siguiendo con el tema de base de datos en Excel, ahora les comparto un ejemplo donde hacemos uso del control Imagen de vba para poder mostrar imágenes en un formulario.

Cómo funciona

Tenemos una tabla de Excel donde insertaremos datos de Super héroes, tales como su Nombre, de qué Editorial provienen, Comentarios, además de insertar la ruta de nuestra PC donde se aloja la Imagen correspondiente.

Base de datos en Excel con imágenes

Figura 1. Tabla de Super héroes con imágenes.

Ver video Alta y Búsqueda de registros incluyendo imágenes

Suscríbete al canal de EXCELeINFO en YouTube para aprender más de Excel y macros.

Alta de registros

Lo interesante de este formulario es que tendremos la opción de elegir una imagen para cada registros que daremos de alta. El listado de imágenes se mostrará en un ListBox donde tendremos una vista previa de cada imagen al elegir cada una de la lista.

Alta de registros en Excel con imagen

Figura 2. Formulario de alta de registros con botón para seleccionar imagen.

Al dar click en el botón Seleccionar (imagen) se muestra un formulario donde habrá un ListBox y tendremos vista previa de nuestras imágenes. Para mostrar la imagen se utilizó el control Imagen y con su propiedad LoadPicture tomamos la ruta completa de la imagen y se carga en el control.

Nota: Para este ejemplo las imágenes deben cargarse en la carpeta imagenes en la misma ubicación del archivo.

Mostrar imágenes en formulario de Excel vba

Figura 3. Al elegir una imagen de la lista tendremos la vista previa.

Búsqueda de registros

Cuando tenemos nuestra tabla con registros, ahora veremos el detalle de cada registro con el formulario Búsqueda de Súper héroes.

Este formulario tiene un ComboBox que es llenado con los datos de la columna Nombre de la tabla y cada vez que elegimos un elemento del Combo se llenan los datos correspondiente y se muestra la imagen. El Combo manda llamar la función BUSCARV (VLOOKUP).

Para que se muestre la imagen será indispensable que la ruta que está en la columna IMAGEN de la tabla, sea correcta.

Formulario de búsqueda en Excel

Figura 4. Formulario para mostrar registros de una tabla y su imagen correspondiente.

Código vba

Macros de módulo normal
Public PathImagenes As String
Public RutaImagen As String
'PathImagenes = ActiveWorkbook.Path & "\imagenes\" as String
'
'Ruta ListFiles donde especificamos la ruta de la carpeta a buscar
Sub ListFiles()
iRow = 2
Call ListMyFiles(PathImagenes, False)
End Sub
'
'Rutina que llena el ListBox de las imágenes
Sub ListMyFiles(mySourcePath, IncludeSubfolders)
Dim Cuenta As Integer
On Error GoTo Errores
Set MyObject = New Scripting.FileSystemObject
Set MySource = MyObject.GetFolder(mySourcePath)
'
On Error Resume Next
Ruta = ListBox1.txtRuta
Ext1 = "png"
Ext = "jpg"
Cuenta = 0
For Each myFile In MySource.Files
    With Application.WorksheetFunction
        Extension = .Trim(Right(.Substitute(myFile.Name, ".", .Rept(" ", 500)), 500))
    End With
    If Ext1 = Extension Or Ext = Extension Then
        With frmImagenes
            .ListBox1.AddItem myFile.Path
            .ListBox1.List(.ListBox1.ListCount - 1, 1) = myFile.Name
        End With
    Else
    End If
Next
If IncludeSubfolders Then
    For Each MySubFolder In MySource.SubFolders
        Call ListMyFiles(MySubFolder.Path, True)
    Next
End If
Exit Sub
Errores:
'
MsgBox "Ha ocurrido un error: " & Err.Description & ".", vbExclamation, "EXCELeINFO"
End Sub
'
'Cada que demos click en un elemento del ListBox llamará a esta macro
Sub MostrarImagen()
With frmImagenes
    Cuenta = .ListBox1.ListCount
    For i = 0 To Cuenta - 1
        If .ListBox1.Selected(i) Then
            .imgPicture.Picture = LoadPicture(PathImagenes & .ListBox1.List(i, 1))
            frmAlta.txtNombreImagen.Caption = .ListBox1.List(i, 1)
            RutaImagen = .ListBox1.List(i, 0)
        End If
    Next i
End With
End Sub
Formulario Alta
'Mostrar el formulario de imágenes
Private Sub CommandButton1_Click()
frmImagenes.Show
End Sub
'
'Macro para alta de registros
Private Sub CommandButton2_Click()
'Declaración de variables
'
Dim strTitulo As String
Dim Continuar As String
Dim TransRowRng As Range
Dim NewRow As Integer
Dim Limpiar As String
'
strTitulo = "EXCELeINFO"
'
Continuar = MsgBox("Dar de alta los datos?", vbYesNo + vbExclamation, strTitulo)
If Continuar = vbNo Then Exit Sub
'
Cuenta = Application.WorksheetFunction.CountIf(Range("A:A"), Me.txtNombre)
'
If Cuenta > 0 Then
    '
    MsgBox "Nombre'" & Me.txtNombre & "' ya se encuentra registrado", vbExclamation, strTitulo
    '
Else
    '
    Set TransRowRng = ThisWorkbook.Worksheets("Super").Cells(1, 1).CurrentRegion
    NewRow = TransRowRng.Rows.Count + 1
    With ThisWorkbook.Worksheets("Super")
        'NOMBRE
        .Cells(NewRow, 1).Value = Me.txtNombre.Value
        'EDITORIAL
        .Cells(NewRow, 2).Value = Me.txtEditorial.Value
        'COMENTARIOS
        .Cells(NewRow, 3).Value = Me.txtComentarios.Value
        'IMAGEN
        .Cells(NewRow, 4).Value = RutaImagen
    End With
    '
    MsgBox "Alta exitosa.", vbInformation, strTitulo
    '
    Unload Me
End If
End Sub
'
'Cerrar el formuario
Private Sub CommandButton3_Click()
Unload Me
End Sub
'
'Al iniciar el formulario
Private Sub UserForm_Initialize()
PathImagenes = ActiveWorkbook.Path & "\imagenes\"
Me.txtComentarios.MultiLine = True
Me.txtComentarios.ScrollBars = fmScrollBarsVertical
End Sub
Formulario Búsqueda
'Al elegir un elemento del Combo se manda llamar la función BUSCARV
Private Sub cmbNombres_Change()
On Error Resume Next
Me.txtEditorial = Application.WorksheetFunction.VLookup(Me.cmbNombres.Value, _
    Sheets("Super").Range("A1:D100"), 2, 0)
Me.txtComentarios = Application.WorksheetFunction.VLookup(Me.cmbNombres.Value, _
    Sheets("Super").Range("A1:D100"), 3, 0)
Me.imgPicture.Picture = LoadPicture(Application.WorksheetFunction.VLookup(Me.cmbNombres.Value, _
    Sheets("Super").Range("A1:D100"), 4, 0))
On Error GoTo 0
End Sub
'
'Cerrar el formulario
Private Sub CommandButton3_Click()
Unload Me
End Sub
'
'Al iniciar el formulario
Private Sub UserForm_Initialize()
Me.cmbNombres.RowSource = "lstNombres"
Me.txtComentarios.MultiLine = True
Me.txtComentarios.ScrollBars = fmScrollBarsVertical
Me.txtEditorial.Locked = True
Me.txtComentarios.Locked = True
End Sub
Formulario Imágenes
'Cerrar el formulario
Private Sub CommandButton1_Click()
Unload Me
End Sub
'
'Al dar click en cada opción del ListBox
Private Sub ListBox1_Click()
Call MostrarImagen
End Sub
'
'Al iniciar el formulario
Private Sub UserForm_Initialize()
Call ListFiles
With Me
    .ListBox1.ColumnCount = 2
    .ListBox1.ColumnWidths = "0 pt;100 pt"
    .imgPicture.Height = 150
    .imgPicture.Width = 170
    .imgPicture.PictureSizeMode = fmPictureSizeModeStretch
End With
End Sub

Anexos

:: Descargar el ejemplo Formulario de Alta y Búsqueda de registros incluyendo imágenes.rar.

Recuerda que si necesitas algún otro ejemplo de Excel puedes realizar la búsqueda de más material en este mismo Blog.

Si te gustó este tutorial por favor regístrate en nuestra Lista de correo y Suscríbete a nuestro canal de YouTube para que estés siempre enterado de lo nuevo que publicamos.

Tags:

You may also like...