Hola:

El archivo lo adjuntó Macro Antonio en otro tema sobre el que quiero preguntar dos cosas:

1) ¿Por qué al añadir una ruta a la lista de imagenes no se actualiza la lista de validación incluyendo dicha ruta (previamente he modificado el código para que la tenga en cuenta, en este caso ya está modificado para que incluya 7 líneas en vez de las 6 que había)? No sé si es problema mío o que es no funcionaba desde fábrica.

2) Si en vez de ajustar por completo la imagen a la celda (desproporcionándose), se puede ajustar solo al alto de celda, y que el ancho sea automático aunque invada -o no- su celda derecha.

Saludos.

Private Sub Worksheet_Change(ByVal Target As Range)

On Error Resume Next

Select Case Target.Column

   Case 1

      [B]For x = 1 To 7[/B] [COLOR=#00ff00]'Rango de la lista de animales[/COLOR]

         If Target.Value = Cells(x, 1) Then Imagen = Cells(x, 2)

      Next x

      ActiveSheet.Pictures.Insert(Imagen).Select

      With Selection.ShapeRange

         .LockAspectRatio = msoFalse

         .Top = Target.Offset(0, 1).Top + 1

         .Left = Target.Offset(0, 1).Left + 1

         .Height = Target.Offset(0, 1).Height - 2

         .Width = Target.Offset(0, 1).Width - 2

      End With

End Select

Target.Offset(0, 2).Select

End Sub[/CODE]

Fotosegunvalor.zip

Vale mas tarde que nunca:

La lista de validación está puesta de forma manual a partir de Datos\Validaciónde datos\Lista y ya venía en el archivo original, porqué yo no recuerdo haberla puesto.

En cuanto a la macro, la modificación es correcta, y si añades mas imágenes, deberás modificar esa línea.

Y en lo relativo a la proporcionalidad de la imagen queda como sigue:

Private Sub Worksheet_Change(ByVal Target As Range)

On Error Resume Next

Select Case Target.Column

   Case 1

      For x = 1 To 7 'Rango de la lista de animales

         If Target.Value = Cells(x, 1) Then Imagen = Cells(x, 2)

      Next x

      ActiveSheet.Pictures.Insert(Imagen).Select

      With Selection.ShapeRange

         .LockAspectRatio = msoFalse

         [COLOR=#0000ff][B] ratio = .Width / .Height[/B][/COLOR]

         .Top = Target.Offset(0, 1).Top + 1

         .Left = Target.Offset(0, 1).Left + 1

         .Height = Target.Offset(0, 1).Height - 2

        [COLOR=#0000ff][B] .Width = .Height * ratio[/B][/COLOR]

      End With

End Select

Target.Offset(0, 2).Select

End Sub




[/CODE]

Gracias por tu respuesta, Macro Antonio.

Al final conseguí solucionar ambas cosas (lista validación y proporcionalidad) por mi cuenta.

Para lo segundo, hice miles de pruebas y hasta que di con la cuestión (ver abajo). La única diferencia es que mi forma me la ajusta a tope (la imagen tapa las lineas de la celda) y la tuya deja un levísimo marco blanco entre la imagen y la celda. La verdad es que me resulta indiferente, solo me ha servido para aprender dos formas de hacer una misma cosa.

With Selection.ShapeRange

.Left = Target.Offset(0, 1).Left

.Top = Target.Offset(0, 1).Top

.Width = Target.Offset(0, 1).Width

.Height = Target.Offset(0, 1).Height

End With

Hola:

Muy bueno, no recordaba que si eliminas .LockAspectRatio = msoFalse se respeta la proporcionalidad, tomando .Height como base de proporción, con lo cual no es necesario especificar la propiedad .Width, ya que no la tiene en cuenta, por tanto la macro podría quedar así:

With Selection.ShapeRange


.Left = target.Offset(0, 1).Left

.Top = target.Offset(0, 1).Top

.Height = target.Offset(0, 1).Height


End With


[/CODE]

Saludos

Mucho más simple así; mejor.

Gracias por todo.

Se puede dar por terminado.