Insertar una Imagen automáticamente en archivo excel a través de un Macro
Me complace compartir con todos Usted; Saludos; quisiera de su apoyo con la finalidad de Insertar la Foto del funcionario o Empleado que mas se destacó en su labor diaria; le aplico una Evaluación a varias personas que no llegan a 20, y quisiera que quien me dé con mayor puntuación en los tres primeros lugares, su código de empleado llame a la foto a un determinado lugar de la hoja; deseo que automáticamente el archivo se vaya actualizando en la medida que se vaya agregando datos de su desempeño. Ya tengo listo la forma en que se realizará el llenado de la plantilla; lo único que me falta es que aparezca automáticamente las fotos del 1er, 2do y 3er lugar utilizando Una Macro...
Con la poca info que brindas ya que no das rangos y demás, voy a hacer algunas suposiciones:
Las fotos a insertar serian en A1.
La foto se llama igual que el dato que esta en "C" o sea, en a1 pone foto de c1, cuya imagen es el mismo valor que hay en la celda C1.
Las fotos están almacenadas en una carpeta llamada "imagenes" dentro de la carpeta donde se encuentra la macro.
El código seria así:
ActiveSheet.DrawingObjects.Delete
ruta = ThisWorkbook.Path & "\Imagenes\"
For I = 1 To 3
imagen = Cells(I, "C")
If Cells(I, "C") = "" Then GoTo salidaa
Range("a1").Select
Dim SArchivo As String
SArchivo = ruta & imagen & ".jpg"
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FileExists(SArchivo) Then
Set img = Excel.ActiveSheet.Pictures.Insert(ruta & imagen & ".jpg")
Else
Set img = Excel.ActiveSheet.Pictures.Insert(ruta & "no image" & ".jpg")
End If
With Cells(I, "A")
Arr = .Top
Izq = .Left
Anc = .Width
Alt = .Height
End With
With img
.ShapeRange.LockAspectRatio = msoFalse
.Top = Arr
.Left = Izq
.Width = Anc
.Height = Alt
End With
Set img = Nothing
salidaa:
Next
Por favor, si te sirvió el código, califícame.
Altamente agradecido por su respuesta... Tienes razón no fui mas específico en la explicación; te explico tengo lo siguiente en hoja3: en celda B16: es para el 1er. Lugar allí aparece el código del funcionario; en celda C16: EL Cargo; en D16: Nombres y Apellidos; E16: Cédula de Identidad; F16: departamento; G16: Puntos; H16: Ubicación... y así hasta llegar a la letra N16: en donde habilité y combiné varias celdas con la finalidad de colocar o que aparezca automáticamente la foto tipo carnet, la cual la tengo archivada en una carpeta llamada COP.
El 2do. Lugar queda registrado en la Fila 17, o sea toda la información anterior pero en las celdas B17: El código del Funcionario en 2do Lugar; C17: el Cargo; D17: Nombres y Apellidos, E17; F17; G17; H17 y así hasta llegar a la letra N23 en donde debe aparecer la foto; allí combiné varias celdas para la foto del 2do lugar.
El Tercer lugar es igual en la única diferencia es en donde debe aparecer la foto, porque debo combinar varias celdas para la foto; me quedaría de la siguiente forma: B18: el Código del funcionario del 3er lugar; C18: Cargo; D18: Nombres y Apellidos; E18; F18; G18; H18 y así hasta llegar a la celda N35 en donde debe aparecer la foto; allí combiné varias celdas para la foto del 3er lugar.
Las Fotos deseo tenerlas en la misma carpeta en donde guardo el archivo; creo que esta es la ruta: "C\Usuarios\José Agüero\Mis documentos\COP"... Me gustaría saber si puedo guardar las fotos también en el mismo Archivo en otra Hoja de excel; lo digo para no complicar su búsqueda o Hipervínculo.
Bueno espero le ayude para poder originar el Macro. cualquier cosa también podríamos comunicarnos por correo [email protected]. Estamos a la orden... Gracias.
Supongamos que el archivo de imagen (foto) tiene por nombre el mismo código que el funcionario, ¿ok? Para que lo inserte en la "hoja3" seria así:
ActiveSheet.DrawingObjects.Delete
' Para un mejor orden te conviene poner las imágenes en una carpeta dentro de donde esta la macro, si lo vas a dejar en la misma carpeta donde esta la macro, dejale a la siguiente línea así:
' ruta = ThisWorkbook.Path
ruta = ThisWorkbook.Path & "\Imagenes\"
imagen = range("b16")' aca pone la celda/combinacion de celdas donde se van a poner las fotos
Range("o16").Select
Dim SArchivo As String
SArchivo = ruta & imagen & ".jpg"
Set fso = CreateObject("Scripting.FileSystemObject")' Acá hace una comprobación y si no existe una imagen con el nombre buscado pondrá una imagen alternativa llamada "no image"
If fso.FileExists(SArchivo) Then
Set img = Excel.ActiveSheet.Pictures.Insert(ruta & imagen & ".jpg")
Else
Set img = Excel.ActiveSheet.Pictures.Insert(ruta & "no image" & ".jpg")
End If
With Selection
Arr = .Top
Izq = .Left
Anc = .Width
Alt = .Height
End With
With img
.ShapeRange.LockAspectRatio = msoFalse
.Top = Arr
.Left = Izq
.Width = Anc
.Height = Alt
End With
Set img = Nothing
Para le resto modifica los parámetros y quedaría.
