martes, 21 de diciembre de 2021

VBA: Imagen asociada a valor celda

Creo que el ejercicio de hoy es algo muy útil y prácatico. Se trata de crear, con VBA para Excel, una UDF que permita asociar una imagen con el dato de una celda.
Claro, podrás decir que eso ya es posible con fórmulas (DESREF, INDICE, INDIRECTO...), de hecho en este mismo blog ya he publicado al respecto:
Un clásico siempre funcional con DESREF
Añadiendo objetos
Con INDIRECTO
y algún caso más, empleando INDICE y COINCIDIR (o incluso BUSCARV)...

Pero todos estos ejemplos tienen un problema NO ADMITEN referencias relativas!!, es decir, si queremos aplicar el método a diez celdas, habría que gestionar diez modelos distintos, i.e., diez nombres definidos distintos, uno por cada celda destino.... y si en lugar de diez son cien??
:OO
Nada práctico

De aquí nace la necesidad de esta Función personalizada, que permitirá aplicar rápidamente en cualquier circunstancia, y con un número ínfimo de nombres definidos esta funcionalidad...

Nuestro punto de partida será nuestro Banco de fotos en una hoja de nuestro libro, donde se listan diferentes códigos y en la celda de su derecha una imágenes situadas y centradas en esas celdas...
Celdas a las que hemos asignado nombres definidos:
A01_ =Hoja1!$C$3
A02_ =Hoja1!$C$4
A03_ =Hoja1!$C$5
A04_ =Hoja1!$C$6

VBA: Imagen asociada a valor celda

La idea es dinamizar la busqueda en los rangos de la derecha (F3:G6 y F9:G13) para que según cambiemos el valor en F3:F6 y en F9:F13, la imagen de su derecha, en la columna G, se ajuste según corresponda...
Por supuesto, NO OLVIDES que las imagenes sobre las que trabajamos responde a imágenes vinculadas!!
Para ello necesitamos algo más... en una celda cualquiera insertamos una autoforma a la que hemos cambiado el nombre por 'Comodin'.
Esta parte es importante ya que será la que evitará que, tras la ejecución de nuestra función, las imágenes queden seleccionadas (TRUCO!!!)
En mi caso lo he añadido encima de la celda F1 (pero puede ser cualquiera!!). Nuestra macro se encargará de ocultarla y/o hacerla visible segú corresponda...

Vamos entonces con el código VBA de nuestra UDF.
He creado dos UDF, una para centrar la imagen en la celda (capricho estético no necesario):
Function CentrarImagenCelda(ByVal imagen As Shape, ByVal celda As Range)
        
    Set miImagen = imagen
    Set celdaImagen = celda
    'centramos la imagen
    miImagen.Top = celdaImagen.Top + (celdaImagen.Height / 2) - (miImagen.Height / 2)
    miImagen.Left = celdaImagen.Left + (celdaImagen.Width / 2) - (miImagen.Width / 2)
    
    'liberamos memoria
    Set miImagen = Nothing
    Set celdaImagen = Nothing

End Function

Esta función trabaja sobre el tamaño de la celda donde se encuentra la imagen, identificando su altura y anchura, así como su punto de inicio (.Top y .Left), para aplicárselo a la imagen seleccionada...

Por otra parte el código de la función que realiza el cambio de la imagen:
Function CambioFormulaImagen(vinculo As Range, FormaRef As String, celdaImagen As Variant)
'ARGUMENTOS:
'1ro 'vinculo' = será el nombre definido asociado a la imagen fuente a recuperar
'2do 'FormaRef' = Celda o Nombre, para identificar la celda o el nombre de la imagen
'3ro 'celdaImagen' = celda donde se ubica la imagen a modificar su fórmula

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

If UCase(FormaRef) = "CELDA" Then
    GoTo celda
ElseIf UCase(FormaRef) = "NOMBRE" Then
    GoTo nombre
Else
    GoTo celda
End If

''''''''''
'controlamos qué tipo de referencia se ha indicado
celda:
For Each pic In ActiveSheet.Shapes
    'https://docs.microsoft.com/es-es/office/vba/api/office.msoshapetype
    If pic.Type = msoPicture And celdaImagen.Address = pic.TopLeftCell.Address Then
        Set img = pic
        Exit For
    End If
Next pic
'cambiamos el vínculo/fórmula de la imagen
img.Select
Selection.Formula = vinculo.Value & "_"

'PLUS!! centramos la imagen en la celda
Call CentrarImagenCelda(img, celdaImagen)

GoTo siguiente

'''''''''''''''
'controlamos qué tipo de referencia se ha indicado
nombre:
ActiveSheet.Shapes(celdaImagen).Select
Selection.Formula = vinculo.Value & "_"

'''''''''''''''
siguiente:

'retornamos un ok si todo ha ido bien ;-)
CambioFormulaImagen = "ok"

'para dejar seleccionada una celda...
'truco para 'engañar' a Excel
With ActiveSheet.Shapes("Comodin")
    .Visible = True
    .Select
    .Visible = False
End With

vinculo.Select

'liberamos memoría!!
Set img = Nothing

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

End Function


Esta función de VBA tiene varias partes...
En la primera gestionamos la variabilidad ofrecida al usuario para trabajar de acuerdo al nombre concreto de la imagen o bien trabajar con la imagen posicionada en una celda concreta indicada (independientemente de cuál sea su nombre!!):
Function CambioFormulaImagen(vinculo As Range, FormaRef As String, celdaImagen As Variant)
'ARGUMENTOS:
'1ro 'vinculo' = será el nombre definido asociado a la imagen fuente a recuperar
'2do 'FormaRef' = Celda o Nombre, para identificar la celda o el nombre de la imagen
'3ro 'celdaImagen' = celda donde se ubica la imagen a modificar su fórmula

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

If UCase(FormaRef) = "CELDA" Then
    GoTo celda
ElseIf UCase(FormaRef) = "NOMBRE" Then
    GoTo nombre
Else
    GoTo celda
End If

[...]

End Function

La siguiente parte del código, según la elección anterior, localiza la imagen entre todas las existentes (por tipo y dirección de celda), o bien ataca directamente a la imagen en caso de conocer su nombre..
Function CambioFormulaImagen(vinculo As Range, FormaRef As String, celdaImagen As Variant)
[...]
'controlamos qué tipo de referencia se ha indicado
celda:
For Each pic In ActiveSheet.Shapes
    'https://docs.microsoft.com/es-es/office/vba/api/office.msoshapetype
    If pic.Type = msoPicture And celdaImagen.Address = pic.TopLeftCell.Address Then
        Set img = pic
        Exit For
    End If
Next pic
'cambiamos el vínculo/fórmula de la imagen
img.Select
Selection.Formula = vinculo.Value & "_"

'PLUS!! centramos la imagen en la celda
Call CentrarImagenCelda(img, celdaImagen)

GoTo siguiente

'''''''''''''''
'controlamos qué tipo de referencia se ha indicado
nombre:
ActiveSheet.Shapes(celdaImagen).Select
Selection.Formula = vinculo.Value & "_"

'''''''''''''''
siguiente:

'retornamos un ok si todo ha ido bien ;-)
CambioFormulaImagen = "ok"

[...]

End Function

Si te fijas bien, no he sido capaz de documentar otra forma, debemos seleccionar la imagen para trabajar sobre ella, y poder cambiar la fórmula asociada, que en definitiva será lo que cambie el aspecto de nuestra imagen.

La parte final es el truco que evita que la imagen anterior quede seleccionada :O
Function CambioFormulaImagen(vinculo As Range, FormaRef As String, celdaImagen As Variant)
[...]

'para dejar seleccionada una celda...
'truco para 'engañar' a Excel
With ActiveSheet.Shapes("Comodin")
    .Visible = True
    .Select
    .Visible = False
End With

vinculo.Select

'liberamos memoría!!
Set img = Nothing

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

End Function

Donde como indicábamos anteriormente el truco es, sobre aquella autoforma insertada (y renombrada como 'Comodin'), aplicarles propiedades para hacerla visible, seleccionarla y volver a hacerla invisible.
Con esta secuencia conseguimos 'deseleccionar' cualquier cosa ;-)

Y nuestra función está lista para trabajar en dos modos.
1- modo nombre de la imagen:
VBA: Imagen asociada a valor celda

En este caso se necesita que todas las imágenes vinculadas tengan nombres distintos!!, lo que hace el trabajo más laborioso. Pero debemos cubrir distintas posibilidades ;-)

2- modo posición de celda:
VBA: Imagen asociada a valor celda

Lo interesante de este caso es que no importa el nombre de la imagen, bastando indicar la celda donde se ubique la imagen 👏👏 No se si habrá un método alternativo o más simple... pero después de rebuscar entre diferente documentación, esta ha sido mi mejor aproximación ;-)

No hay comentarios:

Publicar un comentario

Nota: solo los miembros de este blog pueden publicar comentarios.