Ver Mensaje Individual
  #4 (permalink)  
Antiguo 07/04/2008, 20:20
leoruizb
 
Fecha de Ingreso: abril-2008
Mensajes: 8
Antigüedad: 16 años, 1 mes
Puntos: 0
Re: EXCEL VBA Busqueda de datos

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