Reemplazar Imagenes

En Excel es posible cambiar una imagen por otra conservando sus propiedades como son su tamaño y posición, esto es útil cuando se necesita cambiar una imagen de forma regular por ejemplo en un documento que contenga una fotografía que va cambiando regularmente.
El problema de esto es que no existe en VBA una función que haga ese trabajo, es decir si utilizamos el grabador de macros obtendremos una macro vacía.
Vacio
La solución es que podemos hacer nuestro propio código para hacer el trabajo.
Para cambiar una imagen desde VBA necesitamos un código que se divide en dos partes, uno para obtener la imagen que se va a cambiar y otro para cambiar la imagen.

La primera parte es simple, solamente se obtiene la imagen que activa la ejecución del código (Caller) y se llama a la segunda parte del código para cambiar dicha imagen.

Sub SeleccionarImagen()
    Dim ImagenShape As Excel.Shape
    Set ImagenShape = ActiveSheet.Shapes(Application.Caller)
    If Not ImagenShape Is Nothing Then
        CambiarImagen ImagenShape
    Else
        MsgBox "Llamada a función incorrecta"
    End If
End Sub

La segunda parte consiste en obtener las propiedades que queremos de la imagen original, insertar la nueva imagen y asignarle las propiedades obtenidas y posteriormente eliminar la imagen original.

Sub CambiarImagen(ImagenShapeActual As Excel.Shape)
    On Error Resume Next 'Deshabilita la interrupción de ejecucion por errores
    Application.ScreenUpdating = False 'Deshabilita la actualización de pantalla(evita los parpadeos)
    Application.EnableEvents = False 'Deshabilita los eventos(para evitar que el codigo actual active otros codigos)
    Dim i As Integer
    Dim ImagenShapeNuevo As Excel.Shape
    Dim ArchivoImagen As String
    'Propiedades que se van a conservar de la imagen(se puden agregar mas)
    Dim pName As String
    Dim pOnAction As String
    Dim pLeft As Single
    Dim pTop As Single
    Dim pWidth As Single
    Dim pHeight As Single
    Dim pPlacement As Long
    Dim pLockAspectRatio As Long
    'Se llama al cuadro de dialogo para seleccionar un archivo de imagen
    ArchivoImagen = Application.GetOpenFilename("Imagen, *.bmp;*.gif;*.jpg;*.jpeg;*.png, BMP,*.bmp, GIF,*.gif,     JPG,*.jpg;*.jpeg, PNG,*.png", , "Selecciona...")
    If ArchivoImagen <> "Falso" Then 'Si se seleccionó un archivo
        If Not ImagenShapeActual Is Nothing Then 'Si hay una imagen que cambiar
            'Obtener las propiedades de la imagen
            pName = ImagenShapeActual.Name
            pOnAction = ImagenShapeActual.OnAction 'Importante
            pLeft = ImagenShapeActual.Left
            pTop = ImagenShapeActual.Top
            pWidth = ImagenShapeActual.Width
            pHeight = ImagenShapeActual.Height
            pPlacement = ImagenShapeActual.Placement
            pLockAspectRatio = ImagenShapeActual.LockAspectRatio
            'Se inserta la nueva imagen especificando que sea una copia independiente del archivo original(msoFalse)
            'y que se guarde con el documento de Excel (msoCTrue) para evitar que el logo no se vea en otros equipos
            Set ImagenShapeNuevo = ActiveSheet.Shapes.AddPicture(ArchivoImagen, msoFalse, msoCTrue, pLeft, pTop, pWidth, pHeight)
            If Not ImagenShapeNuevo Is Nothing Then 'Si se insertó correctamente la nueva imagen
                ImagenShapeActual.Delete 'Elimina la imagen original
                'Agrega las propiedades de la imagen original a la nueva imagen
                ImagenShapeNuevo.Name = pName
                ImagenShapeNuevo.OnAction = pOnAction 'Importante
                ImagenShapeNuevo.Left = pLeft
                ImagenShapeNuevo.Top = pTop
                ImagenShapeNuevo.Width = pWidth
                ImagenShapeNuevo.Height = pHeight
                ImagenShapeNuevo.Placement = pPlacement
                ImagenShapeNuevo.LockAspectRatio = pLockAspectRatio
                Set ImagenShapeNuevo = Nothing
            End If
            Set ImagenShapeActual = Nothing
        End If
    End If
    Application.ScreenUpdating = True 'Habilita la actualización de pantalla(para mostrar el cambio realizado)
    Application.EnableEvents = True 'Habilita los eventos
End Sub

 

Este código(las dos partes) se debe agregar en un modulo en el libro de Excel.
Para poner a funcionar el código, seleccionamos una imagen en cualquier hoja del libro y le asignamos la macro “SeleccionarImagen” que es la primera parte del código.

AgregarMacro
Macro

Ahora cada vez que se haga clic en la imagen, se abrirá una ventana donde podremos seleccionar la imagen que queremos y se cambiara la imagen anterior por la que hayamos seleccionado.

Anuncios

2 pensamientos en “Reemplazar Imagenes

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