Código VBA para insertar imagen en una intentar o celda especifica
Para Dante Amor
Master... Aquí molestándote de nuevo...
Será posible me pudieras ayudar con un código VBA para insertar una imagen determinada (C:\imagenes\logo.jpg) en una celda o intentar determinada dentro de una hoja, por ej. Hoja1, celda F2.
Si fuera posible algunas opciones de imágenes, si expandir, centrar o mantener relación, cosas por el estilo como para complementar el código de insertar la imagen.
1 Respuesta
Te anexo algunas opciones:
Sub im4()
'Por.Dante Amor
ruta = "c:\trabajo\"
arch = "fig1.gif"
'
Set fotografia = ActiveSheet.Pictures.Insert(ruta & arch)
With fotografia
.Name = "imagen temporal"
.Top = Range("F2").Top 'Para poner en la celda F2
.Left = Range("F2").Left 'Para poner en la celda F2
.OnAction = "cerrar" 'Si quieres ejecutar una macro
End With
'
'eliminamos el objeto
Set fotografia = Nothing
End SubSub im4()
'Por.Dante Amor
ruta = "c:\trabajo\"
arch = "fig1.gif"
'
Set fotografia = ActiveSheet.Pictures.Insert(ruta & arch)
With fotografia
.Name = "imagen temporal"
.Top = Range("F2").Top 'Para poner en la celda F2
.Left = Range("F2").Left 'Para poner en la celda F2
.Width = Range("F2").Width 'Para que ocupe el ancho de la celda
.Height = Range("F2").Height 'Para que ocupe el alto de la celda
End With
'
'eliminamos el objeto
Set fotografia = Nothing
End SubOtras opciones:
Sub im4()
'Por.Dante Amor
ruta = "c:\trabajo\"
arch = "fig1.gif"
'
Set fotografia = ActiveSheet.Pictures.Insert(ruta & arch)
With fotografia
.Name = "imagen temporal"
.ShapeRange.LockAspectRatio = msoFalse 'bloquear la relación de aspecto
.Top = Range("F2").Top 'Para poner en la celda F2
.Left = Range("F2").Left 'Para poner en la celda F2
.Width = Range("F2").Width 'Para que ocupe el ancho de la celda
.Height = Range("F2").Height 'Para que ocupe el alto de la celda
'
'Para aumentar o diminuir el tamaño:
'. ShapeRange. ScaleHeight 0.25, msoTrue
'. ShapeRange. ScaleWidth 0.25, msoTrue
'
'Para establecer el ancho y alto en centimetros
'.Width = Application.CentimetersToPoints(2.35)
'.Height = Application.CentimetersToPoints(2.35)
'
'Otras propiedades
'.Placement = xlMoveAndSize
End With
'
'eliminamos el objeto
Set fotografia = Nothing
End SubYa con esas propiedades puedes buscar alguna otra que necesites.
Master... Todo bien con los códigos... pero tengo el siguiente problema.... la imagen, es más grande que una celda "estandar" entonces pensé que combinando varias celdas, la ubicacion de la imagen tomaria la nueva direccion F2, que incluia varias celdas en sí. Pero el codigo sigue tomando la original y unica F2 y la imagen queda muy pequeña. Alguna opcion para fijar la imagen dentro de un rango de varias celdas ???
Muchas Gracias!
Así:
Sub im4()
'Por.Dante Amor
ruta = "c:\trabajo\"
arch = "fig1.gif"
'
Set fotografia = ActiveSheet.Pictures.Insert(ruta & arch)
With fotografia
'.Name = "imagen temporal"
'.ShapeRange.LockAspectRatio = msoFalse 'bloquear la relación de aspecto
'.Top = Range("F2").Top 'Para poner en la celda F2
'.Left = Range("F2").Left 'Para poner en la celda F2
'.Width = Range("F2").Width 'Para que ocupe el ancho de la celda
'.Height = Range("F2").Height 'Para que ocupe el alto de la celda
'
'asignamos el rango de celdas que ocupará la foto
With Range("F2")
Arriba = .Top
Izquierda = .Left
Ancho = .Offset(0, .Columns.Count).Left - .Left
Alto = .Offset(.Rows.Count, 0).Top - .Top
End With
'
With fotografia
.Name = "foto de la imagen"
.Top = Arriba
.Left = Izquierda
.Width = Ancho
.Height = Alto
End With
'Para aumentar o diminuir el tamaño:
'. ShapeRange. ScaleHeight 0.25, msoTrue
'. ShapeRange. ScaleWidth 0.25, msoTrue
'
'Para establecer el ancho y alto en centimetros
'.Width = Application.CentimetersToPoints(2.35)
'.Height = Application.CentimetersToPoints(2.35)
'
'Otras propiedades
'.Placement = xlMoveAndSize
End With
'
'eliminamos el objeto
Set fotografia = Nothing
End Sub
