Buscar y traer múltiples imágenes en Excel
La función BUSCARV, nos permite obtener información, en base a un valor buscado, y esa información puede estar en otro libro o en otra hoja de cálculo.
En
este ejemplo, contamos con una plantilla, en la que, seleccionando el nombre
del equipo, se mostrarán los ID, de cada uno de los miembros de dicho equipo,
así como la información relativa de cada uno de ellos. Esta información la
tenemos disponible en la hoja BASE, así como una imagen de cada uno de ellos.
Pero,
además, queremos que nos muestre una imagen de cada uno de los integrantes del
equipo.
Para
ello en la hoja Base, tenemos el nombre de la imagen, tal y como está guardada
en la carpeta Emoticones.
El
archivo con el que estamos trabajando está dentro de la carpeta Ejemplo Macros,
que a su vez contiene la carpeta Emoticones, donde están las imágenes de cada
uno de los jugadores. Observa que los nombres de los archivos de la carpeta
Emoticones, coinciden con los que figuran en la columna foto de hoja BASE.
Así
pues, se irán insertando las imágenes en la celda, siempre que en la celda
adyacente figure el nombre de dicha imagen.
Puedes ver el video aquí.
Como hacer la Macro.
Activamos
la pestaña Programador y hacemos clic en la herramienta Visual Basic
Aquí
está nuestro proyecto que se llama Alineación. Hacemos clic con el botón
derecho e insertamos un Módulo, y se crea un nuevo módulo dónde vamos a
escribir la macro.
Para
crear una macro comenzamos con la palabra Sub , continuamos con el nombre que
damos a la macro y abrimos y cerramos paréntesis:
Sub InsertarImagenes ( )
Y
damos ENTER. Automáticamente se cierra la macro.
Sub
InsertarImagenes ( )
End Sub
Antes
que nada, vamos a definir una serie de variables (son textos a los que asignamos
un tipo de función o valor). En este paso definimos que tipo de variables son:
·
La
variable RutaActual la vamos a definir como una cadena de texto.
Sub
InsertarImagenes ( )
Dim
RutaActual As String
End Sub
La variable RangoImagen como un rango.
Sub
InsertarImagenes ( )
Dim
RutaActual As String
Dim
RangoImagen As Range
End Sub
·
La
variable shp como un objeto
Sub
InsertarImagenes ( )
Dim
RutaActual As String
Dim
RangoImagen As Range
Dim
shp As Object
End Sub
El
primer paso que quiero hacer es crear una rutina que elimine las imágenes que
ya tengamos creadas, y después que se creen unas nuevas.
Vamos
a usar el constructor en el que para cada imagen (a la que denominamos shp) que
haya en la hoja Activa la elimine
Sub
InsertarImagenes ( )
Dim
RutaActual As String
Dim
RangoImagen As Range
Dim
shp As Object
For each shp In
ActiveSheet.Shapes
Shp.Delete
Next
shp
End Sub
Es
decir, cada una de las imágenes que encuentre en la hoja activa las va a ir
eliminando
Una
vez que hemos eliminado cada una de las figuras, ahora sí, vamos a ir
insertando cada una de las nuevas imágenes.
Vamos
a crear una variable que guarde la ruta donde esta guardado el archivo
alineación.
Sub
InsertarImagenes ( )
Dim
RutaActual As String
Dim
RangoImagen As Range
Dim
shp As Object
For each shp In
ActiveSheet.Shapes
Shp.Delete
Next
shp
RutaActual=Thisworkbook.Path
End Sub
Después
vamos a elegir el rango H4 de la hoja que es el lugar donde se mostrará la
primera imagen.
Sub
InsertarImagenes ( )
Dim
RutaActual As String
Dim
RangoImagen As Range
Dim
shp As Object
For each shp In
ActiveSheet.Shapes
Shp.Delete
Next
shp
RutaActual=Thisworkbook.Path
ActiveSheet.Range (“H4”). Select
End Sub
Ahora
lo que tenemos que hacer es recorrer cada una de las celdas a la derecha del
lugar asignado de la imagen y comprobar que no está vacía. De forma que, si la
celda I4 tiene un valor distinto a vacío, inserte la imagen correspondiente en
la celda H4, y así hasta que encuentre una celda vacía, y ahí terminará de
insertar imágenes.
Así
pues, vamos a ordenar que haga la acción mientras la celda Activa sea distinta
de vacío. ¿Y cual es la celda activa que debe mirar? Si partimos de H4, la
celda activa debe de ser I4, esto es en la misma fila que H4, pero en una
columna a la izquierda.
Sub
InsertarImagenes ( )
Dim
RutaActual As String
Dim
RangoImagen As Range
Dim
shp As Object
For each shp In
ActiveSheet.Shapes
Shp.Delete
Next
shp
RutaActual=Thisworkbook.Path
ActiveSheet.Range (“H4”). Select
Do While ActiveCell.Offset (0,-1).Value<>Empty
End Sub
Y
una vez hecha esta comprobación, debe realizarse una acción:
·
Con
la instrucción Set vamos a definir la variable RangoImagen que recoge el valor
de la celda Activa.
Sub
InsertarImagenes ( )
Dim
RutaActual As String
Dim
RangoImagen As Range
Dim
shp As Object
For each shp In
ActiveSheet.Shapes
Shp.Delete
Next
shp
RutaActual=Thisworkbook.Path
ActiveSheet.Range (“H4”). Select
Do While ActiveCell.Offset (0,-1).Value <> Empty
Set RangoImgagen = ActiveCell.Offset (0,-1)
End Sub
· Damos
la instrucción para que se inserte la imagen, pero tenemos que indicar la ruta
completa para llegar al archivo que debe insertar. Recordar que ya creamos una
variable Ruta Actual, que indica la ruta del archivo actual RutaActual y con el
signo & vamos a concatenar el nombre de la carpeta donde están las imágenes
y el nombre del archivo, que es el que figura en la celda de la izquierda a la
celda activa.
Sub
InsertarImagenes ( )
Dim
RutaActual As String
Dim
RangoImagen As Range
Dim
shp As Object
For each shp In
ActiveSheet.Shapes
Shp.Delete
Next
shp
RutaActual=Thisworkbook.Path
ActiveSheet.Range (“H4”). Select
Do While ActiveCell.Offset (0,-1).Value <> Empty
Set RangoImagen = ActiveCell.Offset (0,-1)
ActiveSheet.Pictures.Insert (RutaActual & ”\emoticones\”
& RangoImagen.Value)
End Sub
Una
vez insertada la imagen lo que tenemos que hacer es saltar a la siguiente fila.
Es decir ahora seleccionamos la celda H5
Sub
InsertarImagenes ( )
Dim
RutaActual As String
Dim
RangoImagen As Range
Dim
shp As Object
For each shp In
ActiveSheet.Shapes
Shp.Delete
Next
shp
RutaActual=Thisworkbook.Path
ActiveSheet.Range (“H4”). Select
Do While ActiveCell.Offset (0,-1).Value <> Empty
Set RangoImagen = ActiveCell.Offset (0,-1)
ActiveSheet.Pictures.Insert (RutaActual &
”\emoticones\” & RangoImagen.Value)
ActiveCell.Offset(1,0). Select
End Sub
y
buscar el nombre de la nueva imagen e insertarla. Para que repita el proceso
con las siguientes celdas hasta que encuentre una vacía. Cerramos la
instrucción con Loop
Sub
InsertarImagenes ( )
Dim
RutaActual As String
Dim
RangoImagen As Range
Dim
shp As Object
For each shp In
ActiveSheet.Shapes
Shp.Delete
Next
shp
RutaActual=Thisworkbook.Path
ActiveSheet.Range (“H4”). Select
Do While ActiveCell.Offset (0,-1).Value <> Empty
Set RangoImagen = ActiveCell.Offset (0,-1)
ActiveSheet.Pictures.Insert (RutaActual &
”\emoticones\” & RangoImagen.Value)
ActiveCell.Offset(1,0). Select
Loop
End Sub
A
continuación, le pedimos que cuando finalice de insertar imágenes regrese a la
celda A2.
Sub
InsertarImagenes ( )
Dim
RutaActual As String
Dim
RangoImagen As Range
Dim
shp As Object
For each shp In
ActiveSheet.Shapes
Shp.Delete
Next
shp
RutaActual=Thisworkbook.Path
ActiveSheet.Range (“H4”). Select
Do While ActiveCell.Offset (0,-1).Value <> Empty
Set RangoImagen = ActiveCell.Offset (0,-1)
ActiveSheet.Pictures.Insert (RutaActual &
”\emoticones\” & RangoImagen.Value)
ActiveCell.Offset(1,0). Select
Loop
Range(“A2”).Select
End Sub
Vamos
a pulir la macro, en el caso que en la celda donde aparece el nombre de la
imagen, no se correspondiese con ningún archivo de la carpeta emoticones, la
macro generaría un error, pues no encontraría que archivo debe traer.
Para
evitarlo, antes de empezar la macro vamos a decirle que, si detecta un error,
continue con la macro
Sub
InsertarImagenes ( )
Dim
RutaActual As String
Dim
RangoImagen As Range
Dim
shp As Object
On Error Resume Next
For each shp In
ActiveSheet.Shapes
Shp.Delete
Next
shp
RutaActual=Thisworkbook.Path
ActiveSheet.Range (“H4”). Select
Do While ActiveCell.Offset (0,-1).Value <> Empty
Set RangoImagen = ActiveCell.Offset (0,-1)
ActiveSheet.Pictures.Insert (RutaActual &
”\emoticones\” & RangoImagen.Value)
ActiveCell.Offset(1,0). Select
Loop
Range(“A2”).Select
End Sub
Y
antes de terminar la macro tenemos que desactivar la línea del error, porque si
detectase un error, estaría continuamente ejecutando la macro.
Sub
InsertarImagenes ( )
Dim
RutaActual As String
Dim
RangoImagen As Range
Dim
shp As Object
On Error Resume Next
For each shp In
ActiveSheet.Shapes
Shp.Delete
Next
shp
RutaActual=Thisworkbook.Path
ActiveSheet.Range (“B4”). Select
Do While ActiveCell.Offset (0,-1).Value <> Empty
Set RangoImagen = ActiveCell.Offset (0,-1)
ActiveSheet.Pictures.Insert (RutaActual &
”\emoticones\” & RangoImagen.Value)
ActiveCell.Offset(1,0). Select
Loop
Range(“A2”).Select
On Error GoTo 0
End Sub
Comentarios
Publicar un comentario