Cambiar imagen según el contenido de una celda

Te anexo una macro con la cual podrás poner la foto según el carnet.

Instrucciones
1. Abre tu hoja de excel
2. Para abrir Vba-macros y poder pegar la macro, Presiona ALt + F11
3. En el menú elige Insertar / Módulo
4. En el panel del lado derecho copia la macro
5. Para ejecutarla presiona F5

'***Macro***
Sub poncarnet()
'pone la imagen según un número
'Por.daM
carpeta = "D:\Desktop\IMÁGENES\LISTAS"
carnet = Range("AA8")
Range("AD5").Select
    ActiveSheet.Pictures.Insert(carpeta & carnet & ".bmp"). _
        Select
    Selection.ShapeRange.LockAspectRatio = msoTrue
    Selection.ShapeRange.Height = 44.25
    Selection.ShapeRange.Width = 58.5
    Selection.ShapeRange.Rotation = 0#
End Sub
'***Macro***

Saludos.daM

Apreciado experto: gracias por tu pronta respuesta, pero tu macro no me funciona; no arroja ningún resultado; además te recuerdo que el formato de las imágenes en la carpeta son jpg no bmp; igualmente necesito hacer el mismo Proceso para varias celdas en la misma hoja, no para una sola; agradezco tu oportuna colaboración, ya que me urge terminar mis Carnets. De ser posible te agradecería en forma muy especial, me enviaras un Archivo a mi correo con un ejemplo a [email protected] MUCHAS GRACIAS POR TU PACIENCIA. ESPERO TU RESPUESTA.

Te mando la macro con la corrección de jpg

'***Macro***
Sub poncarnet()
'pone la imagen según un número
'Por.daM
carpeta = "D:\Desktop\IMÁGENES\LISTAS\"
carnet = Range("AA8")
Range("AD5").Select
ActiveSheet.Pictures.Insert(carpeta & carnet & ".jpg"). _
Select
Selection.ShapeRange.LockAspectRatio = msoTrue
Selection.ShapeRange.Height = 44.25
Selection.ShapeRange.Width = 58.5
Selection.ShapeRange.Rotation = 0#
End Sub
'***Macro***

Para repetir el proceso en varias celdas, debe existir una armonía o concordancia de las siguientes celdas, es decir, si el carnet está en a la celda AA8 y la foto la quieres en la celda AD5; el siguiente carnet si está en la celda AA9, la foto se se va a poner en la celda AD6; si el siguiente carnet está en al celda AA10, la foto se va a poner en la celda AD7, espero explicarme.

Si bien comentaste en tu pregunta: "tengo hechos varios Carnets, es decir, necesito cambiar el número de cada Carnet y que en cierta celda, aparezca la foto equivalente a ese mismo número"; esto no me dice que la macro debe hacerlo para todos los carnets, además la referencia en "cierta celda", tampoco me dice mucho.

Podrías ser más específico, darme el detalle en qué columna y qué renglón aparecen los carnet y en qué columna y renglón debe ir la foto, recuerda que debe existir una relación coherente entre un carnet y el siguiente carnet.

Con todo gusto te sigo colaborando.

Saludos. Dam

De nuevo, apreciado experto, vuelvo a incomodarte: Te comento: Al ejecutar la macro, me aparece: Se ha producido el error '1004' en tiempo de ejecución... le doy DEPURAR y aparece en amarillo :

ActiveSheet.Pictures.Insert(carpeta & carnet & ".jpg"). _ Select

Tal vez, existe un error en este renglón y me impide ejecutar el proceso...

respecto a la concordancia de las otras celdas en la misma hoja, estas son las siguientes:

Digitar número en AD5 y su foto en AD8;

# en AD26 - Foto en AB30;

# en AD47 - Foto en AB50;

# en AD68 - Foto en AB72;

# en AD89 - Foto en AB92;

# en AD110 - Foto en AB113;

De nuevo gracias, entiendo perfectamente que para tu labor de experto deberás tener mucha paciencia, como en mi caso... espero atento tu respuesta.

Verifica que la siguiente línea corresponda a tu carpeta de imágenes, Revisa minúsculas y mayúsculas e incluso el acento:

carpeta = "D:\Desktop\IMÁGENES\LISTAS\"

También revisa que el número de carnet que pones en AD5 sea numérico. Prueba esta macro, estaban invertidas las celdas.

'***Macro***
Sub poncarnet()
'pone la imagen según un número
'Por.daM
carpeta = "D:\Desktop\IMÁGENES\LISTAS\"
carnet = Range("AD5")
Range("AA8").Select
ActiveSheet.Pictures.Insert(carpeta & carnet & ".jpg"). _
Select
Selection.ShapeRange.LockAspectRatio = msoTrue
Selection.ShapeRange.Height = 44.25
Selection.ShapeRange.Width = 58.5
Selection.ShapeRange.Rotation = 0#
End Sub
'***Macro***

Ahora para que funcione la macro para todas las líneas, los carnet están bien, veo que entre carnet y carnet hay 21 líneas, pero entre foto y foto no es regular, ya que primero hay 22, luego 20 y la última es de 21 líneas. Debes arreglar para que la foto, al igual que el carnet , aparezca cada 21 líneas.

Saludos. Dam

SIIIII, TU MACRO ES CASI PERFECTA, de manera muy especial, es mi deber agradecer tu tiempo, tu esfuerzo y tu paciencia... la macro ahora si me funciona; sólo quería que por favor, me colaboraras una vez mas, ya que la imagen no aparece en la celda indicada AA8; aparece al lado derecho de la celda en donde dígito el número... Espero si no es mucha molestia, me instruyas al respecto para perfeccionar tu trabajo... sé que es incómodo el tener que volver a revisar lo que ya hiciste, pero en forma muy respetuosa y sin abusar de tu confianza, te agradecería me pudieras colaborar de nuevo.. un abrazo, y de nuevo... muchas, muchas gracias...

Esto debería hacerse asi:

Supongamos que tienes las fotos nombradas asi:

Foto1.jpg

Foto2.jpg

Foto3.jpg

Yque la celda donde ingresaras las fotos será en "A1"

Y que la celda donde insertaras la foto será en la "C1"

Asegurate que la foto tenga una medida estandar y el tamaño de la celda sea lo suficientemente grande para contenerla, lo digo por que si quieres ampliar el código para pegar fotos una debajo de la otra, quedaran una encima de la otra si no le das un tamaño adecuado a la celda. Recuerda que las imagenes no se insertan en la celda, se insertan como objeto sobre la hoja.

Haremos el código en el evento Change de la Hoja. De tal manera que si hay cambios funcionará.

Private Sub Worksheet_Change(ByVal Target As Range)

 If Range("A1").Value <> "" Then

    Range("C1").Select

   ActiveSheet.Pictures.Insert("C:\Users\Freddy\Pictures\Fotografias\" & Range("A1").Value & ".jpg").Select

End If

End Sub

Claro, olvide comentarte que debes colocar en la celda A1 Foto1 ó Foto2 ó Foto3, y estoy asumiendo una ruta donde tienes las fotos, yo las tengo en C:\Users\Freddy\Pictures\Fotografías, esa ruta la cambias por la propia.

Recuerda que si te equivocas en el nombre de la foto, te dará un error.

Apreciado Experto: tu código es casi perfecto... funciona muy bien... pero aún así, le hice algunas adecuaciones para poder ajustar la foto a un tamaño mas pequeño, mira:

Private
Sub Worksheet_Change(ByVal Target As Range)
If Range("A1").Value <>
"" Then
Range("C1").Select
ActiveSheet.Pictures.Insert("D:\Wilson\Desktop\fotines\" &
Range("A1").Value & ".jpg").Select
Selection.ShapeRange.LockAspectRatio
= msoTrue
Selection.ShapeRange.Height
= 44.25
Selection.ShapeRange.Width
= 58.5
Selection.ShapeRange.Rotation
= 0#
End
If
End
Sub

Ahora te pregunto:

1º. Cómo hago para programar lo mismo de la celda A1 en las celdas: A11, A21, A 31 y A41????

2º. ¿SERÁ POSIBLE ADAPTAR ESE CÓDIGO PARA QUE LA IMAGEN APAREZCA NO COMO OBJETO SOBRE LA HOJA SINO DENTRO DE UNA AUTOFORMA, COMO POR EJEMPLO UN CUADRO???

En el siguiente link podrás descargar un archivo de excel. Por favor míralo, y me cuentas si esa es la solución que necesitas. Esta sería mi propuesta para darle solución a tu inquietud.

En el archivo aparece la foto de acuerdo al nombre, pero se puede adecuar para que sea de acuerdo al número.

Sí es lo que necesitas, me dices para explicarte el paso a paso.

Accede a este link.

https://www.dropbox.com/s/cm2gso8qbesvwv0/Ejercicio%20Carnets.xlsx

Éxitos! Estaré atento!

No; no es lo que busco... debo hacer infinidad de carnets, tengo las fotografías ya listas en archivos aparte y sería para mí doble trabajo el tener que ingresar foto por foto en cada celda y luego concatenarlas con la hoja en donde está el formato de los carnets, no es la solución que necesito. Tendrías alguna otra alternativa?