Duda con fotos en excel.

Hola.
Tengo este código y funciona perfectamente, mi pregunta es esta, com puedo hacer lo mismo, ¿con otra celda en la misma hoja? Pongo el nombre de la imagen en la celda B11 y quiero que la coloque en el rango ("D13:G17"). Gracias por tu ayuda, es muy importante para mí, soy a aprendiz.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Foto As Object, Arriba As Double, Izquierda As Double, Ancho As Double, Alto As Double
Dim ruta As String
Application.ScreenUpdating = False
On Error Resume Next
If Not Target = [B1] Then Exit Sub
Me.Shapes("Foto").Delete
Dim carpeta As String
carpeta = "P:\Production\Internal Use\Proyecto\PX80\FOTOS"
ruta = carpeta & "\" & [B1] & ".jpg"
Set Foto = Me.Pictures.Insert(ruta)
With Range("D3:G7")
Arriba = .Top
Izquierda = .Left
Ancho = .Offset(0, .Columns.Count).Left - .Left
Alto = .Offset(.Rows.Count, 0).Top - .Top
End With
With Foto
.Name = "Foto"
.Top = Arriba
.Left = Izquierda
.Width = Ancho
.Height = Alto
End With
Set Foto = Nothing
Application.ScreenUpdating = True
End Sub

2 Respuestas

Respuesta
1
Te explico un poco lo que hace tu rutina para que notes dónde debes ajustarla:
1 -   If not Target = [B1] then exit sub
Estás diciendo que si lo ingresado no coincide con el contenido de B1, finalice. Cambiala por esta otra, que controla lo que ingreses en B1 y B11 8dejá solo la que necesites:
If Target.address(false, false) <> "B1" and target.address(false, false) <> "B11" then exit sub
2-  ruta = carpeta & ..... estás armando el nbre de la imagen con el contenido de B1. Para que te sirva para cualquier celda que estés evaluando, hacé mención al target.
ruta = carpeta & "\" & target.value & ".jpg"
3- El rango dependerá de cuál es la dirección del target, es decir de la celda activa que en tu caso será B1 o B11. Aquí ya necesitarás evaluar con un If, a continuación de
Set Foto ........' tu instrucción
if target.address(false, false) = "B1" then
miRgo = "D3:G7"
elseif target.address(false, false) = "B11" then
miRgo = "D13:G17"
elseif 'otras opciones si las tuvieras
end if
With Range(miRgo)    'a partir de aquí sigue tu rutina
Mil disculpas, creo que esto de la programación no es lo mío, la verdad es que no le entiendo mucho que digamos, tal vez me falte lógica, pero ya le modifique algunas cosas y no función a bien, haber si me ayuda a descubrir mi error, lo que hace es que pone la foto del nombre de la celda b11, pero no la de la b1. esta es la rutina, según yo:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Foto As Object, Arriba As Double, Izquierda As Double, Ancho As Double, Alto As Double
Dim ruta As String
Application.ScreenUpdating = False
On Error Resume Next
If Target.Address(False, False) <> "B1" And Target.Address(False, False) <> "B11" Then Exit Sub
Me.Shapes("Foto").Delete
Dim carpeta As String
carpeta = "P:\Production\Internal Use\PDP Produccion\Santiago_org"
ruta = carpeta & "\" & Target.Value & ".jpg"
Set Foto = Me.Pictures.Insert(ruta)
If Target.Address(False, False) = "B1" Then
miRgo = "D3:G7"
ElseIf Target.Address(False, False) = "B11" Then
miRgo = "D13:G17"
'elseif 'otras opciones si las tuvieras
End If
With Range(miRgo)
Arriba = .Top
Izquierda = .Left
Ancho = .Offset(0, .Columns.Count).Left - .Left
Alto = .Offset(.Rows.Count, 0).Top - .Top
End With
With Foto
.Name = "Foto"
.Top = Arriba
.Left = Izquierda
.Width = Ancho
.Height = Alto
End With
Set Foto = Nothing
Application.ScreenUpdating = True
End Sub
Gracias por su tiempo.
Lo hiciste muy bien. Pero como a todas las imágenes que agregás le llamás 'Foto' y tenés una línea que primero borra la imagen anterior para colocar esta nueva, es que no conservas la de la otra celda.
Me.Shapes("Foto").Delete
Entonces te sugiero esta nueva rutina. Solo elimina la de la celda donde vas a ingresar una nueva. Si tenés + de 2 celdas seguí completando los If .
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Foto As Object, Arriba As Double, Izquierda As Double, Ancho As Double, Alto As Double
Dim ruta As String
Application.ScreenUpdating = False
On Error Resume Next
If Target.Address(False, False) <> "B1" And Target.Address(False, False) <> "B11" Then Exit Sub
'Me.Shapes("Foto").Delete
Dim carpeta As String
carpeta = "P:\Production\Internal Use\PDP Produccion\Santiago_org\"
ruta = carpeta & Target.Value & ".jpg"
Set Foto = Me.Pictures.Insert(ruta)
If Target.Address(False, False) = "B1" Then
miRgo = "D3:G7"
Me.Shapes("Foto01").Delete
ElseIf Target.Address(False, False) = "B11" Then
miRgo = "D13:G17"
Me.Shapes("Foto02").Delete
End If
With Range(miRgo)
Arriba = .Top
Izquierda = .Left
Ancho = .Offset(0, .Columns.Count).Left - .Left
Alto = .Offset(.Rows.Count, 0).Top - .Top
End With
With Foto
If Target.Address(False, False) = "B1" Then
.Name = "Foto01"
ElseIf Target.Address(False, False) = "B11" Then
.Name = "Foto02"
End If
.Top = Arriba
.Left = Izquierda
.Width = Ancho
.Height = Alto
End With
Set Foto = Nothing
Application.ScreenUpdating = True
End Sub
Modifiqué la forma de llamar a las variables carpeta y ruta.
Respuesta
1
Simplemente copia el código en tu hoja, señalé algunos datos que debes reemplazar:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Foto As Object, Arriba As Double, Izquierda As Double, Ancho As Double, Alto As Double
Dim ruta As String
Application.ScreenUpdating = False
On Error Resume Next
If Not Target = [B1] Then Exit Sub  'Reemplaza B1 por B11
Me.Shapes("Foto").Delete
Dim carpeta As String
carpeta = "P:\Production\Internal Use\Proyecto\PX80\FOTOS"
ruta = carpeta & "\" & [B1] & ".jpg" 'Aquí también
Set Foto = Me.Pictures.Insert(ruta)
With Range("D3:G7")  'Reemplaza B3:G7 por D13:G17
Arriba = .Top
Izquierda = .Left
Ancho = .Offset(0, .Columns.Count).Left - .Left
Alto = .Offset(.Rows.Count, 0).Top - .Top
End With
With Foto
.Name = "Foto"
.Top = Arriba
.Left = Izquierda
.Width = Ancho
.Height = Alto
End With
Set Foto = Nothing
Application.ScreenUpdating = True
End Sub
Gracias por tu respuesta, al momento de correr el evento me marca lo siguiente:
Compile error
ambigous name detected: worksheet_change
Espero me puedas ayudar.
El código lo estás pegando en un Módulo o sobre el Worksheet.
El procedimiento sería que hagas clic derecho sobre la pestaña del nombre de la hoja donde se ejecutará el evento y selecciones Ver Código. Y allí pegas el código arriba.
Lo estoy pegando sobre el worksheet.
Gracias por tu tiempo.
Cómo lo estás compilando.
¿Este error dices te sale en Excel? Por lo que dices parece un mensaje de error de Visual Basic.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas

No ejecutar macro al seleccionar una celda vacía

Espero te encuentres genial. Tengo la siguiente macro que inserta una imagen cuando selecciono cualquier celda dentro del rango "A1:A30": Private Sub Worksheet_SelectionChange(ByVal Target As Range) On Error Resume Next If Not Intersect(Target,...
1 respuesta

Macro para mostrar imagen dependiendo del valor de celda Excel 2010 (automático)

Les ruego me por favor me ayuden con la siguiente macro. El problema consiste en que tengo una celda B22 con formato condicional por lo cual varía dependiendo del valor de otra celda, la macro consiste en asociar una imagen que varía acorde con el...
1 respuesta

Insertar imágenes con vb

A ver si consigo explicarme. Excel 2003. He encontrado esto: Private Sub Worksheet_Change(ByVal Target As Range) 'Si ha errores, que continúe On Error Resume Next 'Si cambiamos el dato de la celda C4, 'mostramos la foto de ese vehículo If...
1 respuesta

Fotos en excel con macro, pesa mucho archivo final

Lo que busco es hacer un formulario que me ubique por fotos en una hoja, las imágenes están en una carpeta definida, tengo el siguiente código (lineas abajo), pero, el resultado es un archivo demasiado grande, tanto que cuelga mi maquina, y estoy...
1 respuesta

¿Cómo puedo hacer para llamar una imagen de forma automática usando una macro en una celda?

Tengo el siguiente código de macro que me llama la imagen, pero mi problema esta es que tengo que hacer enter para que me llame la imagen, yo lo que quiero es que a medida que cambio el valor en la celda a1, también me cambie la foto y luego imprimir...
1 respuesta

Macro para comprimir imagen

Quisiera saber si me pueden apoyar. Tengo una Macro que me inserta una imagen en Excel, pero al ejecutarla con otra que me envía un mail con dicha imagen en el cuerpo del mensaje hace que pese alrededor de 2 a 3 MB, lo que es bastante pesado para el...
1 respuesta

Macro para Insertar una Imagen en una celda desde un boton.

Tengo un archivo de excel, alli tengo un boton1 (Sin formulario) y quiero saber si existe alguna macro que al darle click al boton1 me abra la opción de insertar imagen para que el usuario escoja la foto y la inserte en la hoja y además en me...
2 respuestas

¿Qué macro utilizó para insertar una imagen en excel con referencia a una celda?

Que tal quisiera solicitar de su apoyo, estoy elaborando un carnet y si coloco Pedro en la celda H12 se muestre la imagen de pedro, esta foto extraerla de una carpeta externa donde tengo todas las fotos, pero también necesito agregar una condición a...
2 respuestas

Macros para mostrar varias imágenes según valor de celda

Tengo la siguiente macro que me arroja la fotografía de un empleado el teclear su número de empleado en determinada celda. Me gustaría que fueran varias celdas que arrojaran varias imágenes según en número de empleado en la misma hoja. ¿Cómo puedo...
2 respuestas