Insertar foto condicionada a un valor

Estoy intentando insertar una foto que dependa de la calificación
en un cuestionario; he usado las macros de Dan que he visto publicadas pero no me jalan y no encuentro el error, ¿me podrían apoyar?

Sub insertarfoto()
'pone la imagen según un número
'Por.daM
carpeta = "C:\Usuarios\Berenice\Mis imágenes\"
imagen = Range("M10")
Range("L12").Select
ActiveSheet.Pictures.Insert(carpeta & imagen & ".jpg"). _
Select
Selection.ShapeRange.LockAspectRatio = msoTrue
Selection.ShapeRange.Height = 44.25
Selection.ShapeRange.Width = 58.5
Selection.ShapeRange.Rotation = 0#
End Sub

1 respuesta

Respuesta
1

Lo reviso y te aviso

Saludos. Dante Amor

Lo que pasa es que tienes la extensión del archivo en la celda M7 y también en la macro.

Deja la extensión en la celda y cambia esta línea

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

Por esta

ActiveSheet.Pictures.Insert(carpeta & imagen).Select

Saludos. Dante Amor

No olvides finalizar la pregunta.

Hola Dan:

Me sigue generando el mismo error.

En la celda M7 tengo PRojo.jpg que es el nombre de mi archivo y la macro quedó así:

Sub insertarfoto()
'pone la imagen según un número
'Por.daM
carpeta = "C:\Usuarios\Berenice\Mis imágenes\"
imagen = Range("M7")
Range("L9").Select
ActiveSheet.Pictures.Insert(carpeta & imagen).Select
Selection.ShapeRange.LockAspectRatio = msoTrue
Selection.ShapeRange.Height = 44.25
Selection.ShapeRange.Width = 58.5
Selection.ShapeRange.Rotation = 0#
End Sub

Al correrla me manda un error y vuelve a colorear en amarillo el renglón:

ActiveSheet.Pictures.Insert(carpeta & imagen).Select

Quedo atenta ;)

Puedes poner tus imágenes directamente en C:\

Y modifica la macro así

ActiveSheet.Pictures.Insert("C:\" & imagen).Select

Si no te funciona, envíame el archivo de tu imagen, para revisar la extensión correcta.

Hola, :( no puedo por cuestiones de seguridad colocar los archivos directo en c, pero si me permite hacer una carpeta y meterlos ahí pero no directo

Lo que pasa es que no está encontrando el archivo y no sé exactamente la ruta que tienes.

Si no puedes ponerlo en "C:\" entonces crea una carpeta que sea así "C:\imagen" y en la macro queda así

ActiveSheet.Pictures.Insert("C:\imagen\" & imagen).Select

Mil gracias, ya jaló sólo que no lo pone en la celda que quería y no lo hace en automático, es decir, si cambio el valor de manera manual tengo que meterme a ejecutar la macro no lo hace sola, cómo podría arreglarla, con un botón o algo? Cómo ves?

Para que quede en la celda que necesitas:

Sub insertarfoto()
'pone la imagen según un número
'Por.daM
'carpeta = "C:\Usuarios\Berenice\Mis imágenes\"
'carpeta = "C:\imagen\"
imagen = Range("M7")
Range("L9").Select
izq = Range("L9").Left
arr = Range("L9").Top
ActiveSheet.Pictures.Insert("C:\imagen\" & imagen).Select
Selection.ShapeRange.LockAspectRatio = msoFalse
Selection.ShapeRange.Height = 65
Selection.ShapeRange.Width = 107
Selection.ShapeRange.Rotation = 0#
Selection.ShapeRange.Left = izq
Selection.ShapeRange.Top = arr
End Sub

Si quieres que sea en automático, tienes que poner la macro en un evento de worksheet así:

Sigue las Instrucciones para poner la macro en worksheet
1. Abre tu libro de excel
2. Para abrir Vba-macros y poder pegar la macro, Presiona Alt + F11
3. Del lado izquierdo dice: VBAProject, abajo dale doble click a worksheet(tu hoja)
4. Del lado derecho copia la macro

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("L7")) Is Nothing Then
 imagen = Range("M7")
 izq = Range("L9").Left
 arr = Range("L9").Top
 ActiveSheet.Pictures.Insert("C:\imagen\" & imagen).Select
 Selection.ShapeRange.LockAspectRatio = msoFalse
 Selection.ShapeRange.Height = 65
 Selection.ShapeRange.Width = 107
 Selection.ShapeRange.Rotation = 0#
 Selection.ShapeRange.Left = izq
 Selection.ShapeRange.Top = arr
End If
End Sub

Cambia en esta macro, en esta línea, "L7" por la celda en donde pongas un dato y con ese dato la imagen se actualice.

If Not Intersect(Target, Range("L7")) Is Nothing Then

Saludos. Dante Amor

No olvides finalizar

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas