Excel - error con macro

   
Vista:

error con macro

Publicado por Mario Rojas (1 intervención) el 14/10/2014 15:49:58
HOLA tengo un código que me había funcionado de mil maravilla se me fue un disco duro y ahora no me sirve, quiera ver si alguno me ayuda para
Repararlo.
La idea es que cuando cambia la celda el me busque la imagen y me la pegue en la hoja.
Pero desde el evento del disco duro ya no me funciona y no se por qué. Gracias de antemano con la ayuda.


___________________


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.ScreenUpdating = False
'Si ha errores, que continúe
On Error Resume Next
'Si cambiamos el dato de la celda T25,
'mostramos la foto de ese vehículo
If Target.Cells = Range("T25") Then
'Ocultamos el procedimiento
'pasamos a una variable, el nombre de la foto,
'que será el mismo que el nombre del articulo, pero
'separado con guiones, y sin acentos, para que
'todos los usuarios puedan verlo correctamente
Foto = Range("T25").Value
'en la foto, reemplazamos los espacios, por guiones
'foto = Replace(foto, " ", "-")
'ahora le añadimos la extensión "jpg"
Foto = Foto & ".jpg"
'ahora buscamos la foto en el mismo directorio
'donde tenemos este fichero de excel
rutayarchivo = ActiveWorkbook.Path & "\IMAGENES\" & Foto
'borramos la foto del coche (si hubiera alguna)
'Me.Shapes("foto_del_Articulo").Delete
'creamos el objeto fotografia, con la foto insertada
Set fotografia = Me.Pictures.Insert(rutayarchivo)
'haremos que la foto ocupe desde B6 hasta D21,
'para que no salgan fotos supergrandes, o
'superpequeñas, y salgan más "normalitas"
With Range("T24:U27")
Arriba = .Top
Izquierda = .Left
Ancho = .Offset(0, .Columns.Count).Left - .Left
Alto = .Offset(.Rows.Count, 0).Top - .Top
End With
'le ponemos un nombre al objeto "fotografia"
'para poder borrarla cuando cambie la celda D6
'(ver que borramos la foto que hubiese, antes de insertar la nueva)
With fotografia
.Name = "foto_del_Articulo"
.Top = Arriba
.Left = Izquierda
.Width = Ancho
.Height = Alto
End With
'eliminamos el objeto
Set fotografia = Nothing
'ponemos todo como estaba
Application.ScreenUpdating = True
End If
End Sub
Valora esta pregunta
Me gusta: Está pregunta es útil y esta claraNo me gusta: Está pregunta no esta clara o no es útil
0
Responder