De formula a código

Hola Héctor

mira lo que realmente quiero es que con solo bajar o subir con las flechas
de dirección me muestre la imagen
te anexo una liga de ahí puedes ver como lo tengo nuevamente gracias por tu
fina atención

un saludo,
DanielSL

De aquí lo descargas:


http://www.4shared.com/file/3180441...magen.html

hola, Daniel !

... quiero... que con solo bajar o subir con las flechas de direccion me muestre la imagen
http://www.4shared.com/file/3180441...magen.html

(creo que) solo necesitas las siguientes lineas en el modulo de codigo de la hoja...
corre algunas pruebas y... si cualquier duda (o informacion adicional)... comentas ?
saludos,
hector.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim De_donde As String, Foto As Object, _
Arriba As Double, Izquierda As Double, _
Ancho As Double, Alto As Double
Static Fila As Integer
If Target.Row = Fila Then Exit Sub
Application.ScreenUpdating = False
On Error Resume Next
Me.Shapes("La_Foto").Delete
On Error GoTo 0
De_donde = "c:\inventario2007\" & Cells(Fila, 1) & ".jpg"
If Dir(Range("am" & Target.Row)) = "" Then Exit Sub
With Me.Range("f5:k24")
Arriba = .Top
Izquierda = .Left
Ancho = .Offset(, .Columns.Count).Left - .Left
Alto = .Offset(.Rows.Count).Top - .Top
End With
Set Foto = Me.Pictures.Insert(De_donde)
With Foto
.Name = "La_Foto"
.Top = Arriba
.Left = Izquierda
.Width = Ancho
.Height = Alto
End With
Set Foto = Nothing
Fila = Target.Row
End Sub

Hola Héctor... te comento lo que paso después de hacer unas pruebas

Sub RestablecerEventos()
Application.EnableEvents = True
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range):
If Not Application.Intersect(Target, Range("a5:au1999")) Is Nothing _
Then Range("A2") = Target.Row
Range("b3").Formula = Range("b2").Formula
End Sub
******** ************ **************
******** ************ **************

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

********
******** aqui marca error de compilacion: se ha detectado un nombre
ambiguo:Workshet_selectionChange*****

Bueno en esta parte solo afecte en el codigo antes de los astericos le puse
unas comillas y segun yo soluciona el problema pero no luego me manda el
siguiente mensaje

Dim De_donde As String, Foto As Object, _
Arriba As Double, Izquierda As Double, _
Ancho As Double, Alto As Double
Static Fila As Integer
If Target.Row = Fila Then Exit Sub
Application.ScreenUpdating = False
On Error Resume Next
Me.Shapes("La_Foto").Delete
On Error GoTo 0

*******

De_donde = "c:\inventario2007\" & Cells(Fila, 1) & ".jpg"

*******
*******Se ha producido el error '1004' en tiempo de ejecucion error definido
por la aplicion o el objeto

If Dir(Range("am" & Target.Row)) = "" Then Exit Sub
With Me.Range("f5:k24")
Arriba = .Top
Izquierda = .Left
Ancho = .Offset(, .Columns.Count).Left - .Left
Alto = .Offset(.Rows.Count).Top - .Top
End With
Set Foto = Me.Pictures.Insert(De_donde)
With Foto
.Name = "La_Foto"
.Top = Arriba
.Left = Izquierda
.Width = Ancho
.Height = Alto
End With
Set Foto = Nothing
Fila = Target.Row
End Sub

hola, Daniel !

... te comento lo que paso despues de hacer unas pruebas
Private Sub Worksheet_SelectionChange(ByVal Target As Range):
If Not Application.Intersect(Target, Range("a5:au1999")) Is Nothing _
Then Range("A2") = Target.Row
Range("b3").Formula = Range("b2").Formula
End Sub
******** ************ **************
******** ************ **************

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

***** aqui marca error de compilacion: se ha detectado un nombre ambiguo:Workshet_selectionChange*****

1) no puedes tener procedimientos con el mismo nombre en un mismo proyecto de vba
(conserva solo uno de ellos y/o pon una marca de comentario al otro procedimiento -por si regresas a su uso-)

Bueno en esta parte solo afecte en el codigo antes de los astericos le puse unas comillas y segun yo soluciona el problema
pero no luego me manda el siguiente mensaje

Dim De_donde As String, Foto As Object, _
Arriba As Double, Izquierda As Double, _
Ancho As Double, Alto As Double
Static Fila As Integer
If Target.Row = Fila Then Exit Sub
Application.ScreenUpdating = False
On Error Resume Next
Me.Shapes("La_Foto").Delete
On Error GoTo 0

******* De_donde = "c:\inventario2007\" & Cells(Fila, 1) & ".jpg" *******
*******Se ha producido el error '1004' en tiempo de ejecucion error definido por la aplicion o el objeto

2) es cierto, cambia la forma de hacer referencia a la fila seleciconada:
de: -> De_donde = "c:\inventario2007\" & Cells(Fila, 1) & ".jpg"
a: -> De_donde = "c:\inventario2007\" & Cells(Target.Row, 1) & ".jpg"

(perdon, hice parches/adaptaciones/... de codigos anteriores sin hacer pruebas) :-((

si cualquier duda (o informacion adicional)... comentas ?
saludos,
hector.

Hola Héctor.
Gracias por contestar te comento...

quedo de esta forma el código:

Private Sub Worksheet_SelectionChange(ByVal Target As Range):
If Not Application.Intersect(Target, Range("a5:au1999")) Is Nothing _
Then Range("A2") = Target.Row
Range("b3").Formula = Range("b2").Formula
'End Sub
'Private Sub Worksheet_SelectionChange(ByVal Target As Range):
Dim De_donde As String, Foto As Object, _
Arriba As Double, Izquierda As Double, _
Ancho As Double, Alto As Double
Static Fila As Integer
If Target.Row = Fila Then Exit Sub
Application.ScreenUpdating = False
On Error Resume Next
Me.Shapes("La_Foto").Delete
On Error GoTo 0
'De_donde = "c:\Inventario2007\" & Cells(Fila, 1) & ".jpg"

De_donde = "c:\inventario2007\" & Cells(Target.Row, 1) & ".jpg"

******
If Dir(Range("am" & Target.Row)) = "" Then Exit Sub
******
****aqui marca que que se ha produccido el error '13' en tiempo de
ejecucion:
****no coinciden los tipos :( que hago pliss


With Me.Range("f5:k24")
Arriba = .Top
Izquierda = .Left
Ancho = .Offset(, .Columns.Count).Left - .Left
Alto = .Offset(.Rows.Count).Top - .Top
End With
Set Foto = Me.Pictures.Insert(De_donde)
With Foto
.Name = "La_Foto"
.Top = Arriba
.Left = Izquierda
.Width = Ancho
.Height = Alto
End With
Set Foto = Nothing
Fila = Target.Row
End Sub

Gracias por tu apoyo

Un saludo,
DanielSL