EXCEL VBA Busqueda de datos

[leoruizb]

Saludos,

Necesito convertir una funcion de Excel español normal a Excel-VBA.

La funcion en Excel que me funciona perfectamente es:
=BUSCAR(B8;'[datos.xlsx]datos'!$A:$A;'[datos.xlsx]datos'!$J:$J)

Pero cuando la trato de pasar a Excel-VBA para ponerla dentro de un programita que la debo pasar a ingles:
dir = Application.LOOKUP(B8,[datos.xlsx]datos!$A:$A,[datos.xlsx]datos!$J:$J)
Me da un error.

No se que estoy haciendo mal.

La idea es que de mi hoja de calculo actual, me busque una dirección fisica de la ubicación de un archivo (una foto) en otra hoja de calculo donde estan todos los datos y me muestre unas fotos en unas celdas especificas de mi hoja de calculo actual.

Espero su ayuda,
Gracias
bye

Leo

[abrahamvj]

No he revisado detalladamente tu instruccion, ya que antes quiero saber algo. Tienes abierto el libro datos.xlsx o cerrado??? Te pregunto porque debe estar abierto, sino, no te funcionara la instruccion

Abraham

[leoruizb]

Saludos Abraham,

Te cuento que he avanzado en la solucion de mi problema.

Decidi primero que nada colocar la base de datos en una hoja del mismo archivo para poder hacer las pruebas antes de colocarla en otra hoja de excel externa como originalmente deben estar.

El nuevo codigo es el siguiente:

Sub poneimagen()
Dim dir As String
Dim buscar As String
Dim datos As Object
Dim hoja1 As Object
Set datos = Worksheets("datos")
Set hoja1 = Worksheets("Hoja1")
buscar = hoja1.Range("B8")
MsgBox Mid(buscar, 1)
dir = Application.WorksheetFunction.Lookup(buscar, datos.Range("A1:A200"), datos.Range("J1:J200"))
MsgBox Mid(dir, 1)
End Sub

y parece que esta trabajando. Ya no me da los errores de antes pero ahora tengo un nuevo problema y es que NO me ubica el registro que estoy buscando.
El valor de "buscar" es 107 y me trajo los datos del registro 100
que es la siguiente dirección: "C:\redgeodesica\v100\100uc.jpg"
Voy a revisar a ver que es lo que esta pasando.

Luego tengo que agregar el codigo para insertar las imagenes con las direcciones que este primer programa me va a arrojar.

Si tienes alguna sugerencia, me avisas porfavor.

Gracias de antemano.
bye

Leo

[leoruizb]

Saludos,

Ya resolvi parte de mi problema y el codigo que les anexo esta funcionando bien.
Aun me quedan dos cosas por resolver a ver si me pueden dar una mano:
1- Centrar las imagenes
2- Leer la direccion de ubicacion fisica de las imagenes desde otra hoja de excel diferente a la que tengo, porque no voy a poder copiar la base de datos completa en todas las hojas de calculo de cada una de las fichas.
Les dejo el codigo a ver si me pueden ayudar:

Sub TestInsertPictureInRange()
' With the macro below you can insert pictures and fit them to any range in a worksheet.
Dim buscar As String
Dim dato As Object, hoja1 As Object
Dim diruc As String, dircad As String, dirp As String, diruf As String
Set dato = Worksheets("datos")
Set hoja1 = Worksheets("Hoja1")
buscar = hoja1.Range("B8")
diruc = Application.WorksheetFunction.Lookup(buscar, dato.Range("A1:A200"), dato.Range("J1:J200"))
dircad = Application.WorksheetFunction.Lookup(buscar, dato.Range("A1:A200"), dato.Range("K1:K200"))
dirp = Application.WorksheetFunction.Lookup(buscar, dato.Range("A1:A200"), dato.Range("L1:L200"))
diruf = Application.WorksheetFunction.Lookup(buscar, dato.Range("A1:A200"), dato.Range("M1:M200"))

Insertarimagen diruc, Range("A16")
Insertarimagen dircad, Range("D16")
Insertarimagen dirp, Range("A29")
Insertarimagen diruf, Range("D29")

End Sub

Sub Insertarimagen(PictureFileName As String, TargetCells As Range)
' inserts a picture and resizes it to fit the TargetCells range
Dim p As Object, t As Double, l As Double, w As Double, h As Double
If TypeName(ActiveSheet) <> "Worksheet" Then Exit Sub
If dir(PictureFileName) = "" Then Exit Sub

' import picture
Set p = ActiveSheet.Pictures.Insert(PictureFileName)
' determine positions
With TargetCells
t = .Top
l = .Left
w = .Offset(0, .Columns.Count).Left - .Left
h = .Offset(.Rows.Count, 0).Top - .Top
End With
' position picture
With p
.Top = t
.Left = l
.Width = w
.Height = h
End With
Set p = Nothing
End Sub

El codigo lo saque de varios foros de excel luego de 4 dias continuos de trabajo, investigacion, estudio, programacion y pruebas.

Espero que les sea de utilidad a los demas.
bye

Leo

[leoruizb]

Saludos,

Ya por fin pude poner a trabajar el sistema conectando las dos hojas de calculo entre si. Busco los datos (direccion fisica de las imagenes) en una hoja de calculo que tiene toda la base de datos y esta me genera la ficha y ademas busca y pega las 4 imagenes y las coloca en la ficha en la celda que corresponde.

Ahora solo me queda centrar cada una de las imagenes en la celda respectiva y espero que me den una ayuda. De todas maneras mañana me pondre a buscar en internet a ver si consigo algo que me ayude a resolver esto porque el codigo actual me ubica la imagen en el top de la celda y a la izquierda. Yo la necesito un poco mas pequeña y centrada en la celda.

Aqui les dejo la ultima version del codigo que llevo hasta este momento.
Seguimos en contacto.
bye

Leo

Sub InsertarImagenRango()
' With the macro below you can insert pictures and fit them to any range in a worksheet.
Dim buscar As String
Dim dato As Object, hoja1 As Object
Dim diruc As String, dircad As String, dirp As String, diruf As String
Dim hdato As Workbook

Set hoja1 = Worksheets("Hoja1")
buscar = hoja1.Range("B8")

Set hdato = Workbooks.Open("C:\redgeodesica\datos.xlsx")
Set dato = Worksheets("datos")

diruc = Application.WorksheetFunction.Lookup(buscar, dato.Range("A1:A200"), dato.Range("J1:J200"))
dircad = Application.WorksheetFunction.Lookup(buscar, dato.Range("A1:A200"), dato.Range("K1:K200"))
dirp = Application.WorksheetFunction.Lookup(buscar, dato.Range("A1:A200"), dato.Range("L1:L200"))
diruf = Application.WorksheetFunction.Lookup(buscar, dato.Range("A1:A200"), dato.Range("M1:M200"))

ThisWorkbook.Activate

Insertarimagen diruc, Range("A16")
Insertarimagen dircad, Range("D16")
Insertarimagen dirp, Range("A29")
Insertarimagen diruf, Range("D29")

End Sub

Sub Insertarimagen(PictureFileName As String, TargetCells As Range)
' inserts a picture and resizes it to fit the TargetCells range
Dim p As Object, t As Double, l As Double, w As Double, h As Double
If TypeName(ActiveSheet) <> "Worksheet" Then Exit Sub
If dir(PictureFileName) = "" Then Exit Sub
' import picture
Set p = ActiveSheet.Pictures.Insert(PictureFileName)
' determine positions
With TargetCells
t = .Top
l = .Left
w = .Offset(0, .Columns.Count).Left - .Left
h = .Offset(.Rows.Count, 0).Top - .Top
End With
' position picture
With p
.Top = t
.Left = l
.Width = w
.Height = h
End With
Set p = Nothing
End Sub