Galeria de Imagenes

Excel a pesar de que no es un software para presentaciones en ocasiones necesitamos mostrar imágenes; cuando tenemos espacio suficiente podemos agregar todas las imágenes que necesitemos sin problema pero si queremos ahorrar espacio podemos crear una galería tipo slider haciendo lo siguiente.

  1. En una hoja de Excel, insertar un rectángulo y quitarle el contorno, en este rectángulo se mostraran las imágenes.
    Redimensionar el rectángulo al tamaño que se desee.
    Renombrar el cuadro a “Imagen” (sin comillas), esto para que funcione el código, si se desea poner otro nombre se debe ajustar el código.
  2. Insertar un cheurón (véase imagen) a cada lado del rectángulo, estos servirán para desplazarse por las imágenes.
  3. Seleccionar una celda y ponerle el nombre de “Carpeta”, esto para que funcione el código, si se desea poner otro nombre se debe ajustar el código, en esta celda se colocara la ubicación de la imagen mostrada.
  4. Agregar un rectángulo pequeño al lado de la celda que seleccionamos, este servirá como botón para seleccionar la primera imagen.
  5. En un módulo agregamos los siguientes códigos.
    Apis para busqueda de archivos

    Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
    Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
    Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
    Const MAX_PATH = 260
    Const MAXDWORD = &HFFFF
    Const INVALID_HANDLE_VALUE = -1
    Const FILE_ATTRIBUTE_ARCHIVE = &H20
    Const FILE_ATTRIBUTE_DIRECTORY = &H10
    Const FILE_ATTRIBUTE_HIDDEN = &H2
    Const FILE_ATTRIBUTE_NORMAL = &H80
    Const FILE_ATTRIBUTE_READONLY = &H1
    Const FILE_ATTRIBUTE_SYSTEM = &H4
    Const FILE_ATTRIBUTE_TEMPORARY = &H100
     
    Private Type FILETIME
        dwLowDateTime As Long
        dwHighDateTime As Long
    End Type
     
    Private Type WIN32_FIND_DATA
        dwFileAttributes As Long
        ftCreationTime As FILETIME
        ftLastAccessTime As FILETIME
        ftLastWriteTime As FILETIME
        nFileSizeHigh As Long
        nFileSizeLow As Long
        dwReserved0 As Long
        dwReserved1 As Long
        cFileName As String * MAX_PATH
        cAlternate As String * 14
    End Type
    
    Function StripNulls(OriginalStr As String) As String
        If (InStr(OriginalStr, Chr(0)) > 0) Then
            OriginalStr = Left(OriginalStr, InStr(OriginalStr, Chr(0)) - 1)
        End If
        StripNulls = OriginalStr
    End Function
    


    Código para los botónes

    Sub SeleccionarCarpeta()
        Application.EnableEvents = False
        Application.ScreenUpdating = False
        Dim strImagenNew As String
        Dim i As Integer
        Dim j As Integer
        strImagenNew = Application.GetOpenFilename("Archivos de imagen(*.bmp;*.gif;*.jpg;*.png), *.bmp;*.gif;*.jpg;*.png", , "Selecciona...")
        If strImagenNew <> "Falso" Then
            Sheets("Hoja1").Shapes("Imagen").Fill.UserPicture strImagenNew
            Sheets("Hoja1").Range("Carpeta") = strImagenNew
        Else
            Exit Sub
        End If
        Application.EnableEvents = True
    End Sub
    
    Sub toLeft()
        Dim imagen As String
        imagen = SiguienteImagen("previous")
        If imagen <> Empty Then
            Sheets("Hoja1").Shapes("Imagen").Fill.UserPicture imagen
            Sheets("Hoja1").Range("Carpeta") = imagen
        End If
    End Sub
    Sub toRight()
        Dim imagen As String
        imagen = SiguienteImagen("next")
        If imagen <> Empty Then
            Sheets("Hoja1").Shapes("Imagen").Fill.UserPicture imagen
            Sheets("Hoja1").Range("Carpeta") = imagen
        End If
    End Sub
    


    Código para obtener las imagenes (usando las Apis)

    Function SiguienteImagen(direccion As String)
        Dim carpeta As String
        Dim busqueda As String
        Dim archivo As String
        Dim archivoInicial As String
        Dim extension As String
        Dim i As Integer
        Dim resultado As Long
        Dim WFD As WIN32_FIND_DATA
        Dim actual As Boolean
        Dim previous As String
        Dim cont As Integer
        archivoInicial = Sheets("Hoja1").Range("Carpeta")
        carpeta = Mid(archivoInicial, 1, InStrRev(archivoInicial, "\"))
        busqueda = "*.*" 'Todos los archivos
        If Right(carpeta, 1) <> "\" Then carpeta = carpeta & "\"
        'Busqueda del archivo en carpeta actual
        resultado = FindFirstFile(carpeta & busqueda, WFD)
        cont = True
        actual = False
        If resultado <> INVALID_HANDLE_VALUE Then
            While cont And SiguienteImagen = Empty
                archivo = StripNulls(WFD.cFileName)
                If (archivo <> ".") And (archivo <> "..") Then
                    extension = Right(archivo, Len(archivo) - InStrRev(archivo, "."))
                    If extension = "bmp" Or extension = "gif" Or extension = "jpg" Or extension = "png" Then
                        If direccion = "next" Then
                            If actual Then SiguienteImagen = carpeta & archivo
                            If (carpeta & archivo) = archivoInicial Then actual = True
                        ElseIf direccion = "previous" Then
                            If (carpeta & archivo) = archivoInicial Then SiguienteImagen = previous
                            previous = carpeta & archivo
                        End If
                    End If
                End If
                cont = FindNextFile(resultado, WFD)
            Wend
            cont = FindClose(resultado)
        End If
    End Function
    


  6. Agregar el código “SeleccionarCarpeta” al botón que se agregó en el paso 6.
  7. Agregar el código “toLeft” al cheurón del lado izquierdo y “toRight” al cheurón del lado derecho.
  8. Hacer clic en el botón del paso 6 para seleccionar la primera imagen.
  9. Hacer clic en el cheurón derecho para ver la siguiente imagen.

Si te gusto el artículo no dudes en comentar y compartir.

Anuncios

Responder

Introduce tus datos o haz clic en un icono para iniciar sesión:

Logo de WordPress.com

Estás comentando usando tu cuenta de WordPress.com. Cerrar sesión /  Cambiar )

Google photo

Estás comentando usando tu cuenta de Google. Cerrar sesión /  Cambiar )

Imagen de Twitter

Estás comentando usando tu cuenta de Twitter. Cerrar sesión /  Cambiar )

Foto de Facebook

Estás comentando usando tu cuenta de Facebook. Cerrar sesión /  Cambiar )

Conectando a %s