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
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 SubSi 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 SubCambia 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
