Anónimo
Ajustar imagen extraída desde URL
Esperando se encuentren bien, les comento que tengo una macro que funciona sin problemas su funcionamiento es de acuerdo a valor de celda extrae una imagen desde una dirección URL, solo que no logro agregar 2 funciones más.
1. Al cambiar valor en celda se ejecute la macro.
2. Ajustar la imagen de acuerdo a las siguientes medidas (la imagen esta en celdas combinadas de "B9:B12"
Alto: 3.01 cm
Ancho: 4.85 cm
Ajustar alto: 9%
Ajustar ancho: 11%
Anexo código.
Gracias por el tiempo y el apoyo.
Sub GetShapeFromWeb(strShpUrl As String, rngTarget As Range)
With rngTarget.Parent
.Pictures.Insert strShpUrl
.Shapes(.Shapes.Count).Left = rngTarget.Left
.Shapes(.Shapes.Count).Top = rngTarget.Top
End With
End Sub
Sub Obtener_imagen()
On Error Resume Next
i = 9
Call GetShapeFromWeb(Range("AY" & i).Value, Hoja1.Range("a65536").End(xlUp).Offset(i - 1, 0))
End Sub
1 Respuesta
H o l a : Ya no entendí, quieres ajustar la imagen al tamaño de las celdas B9:B12. Si es así, entonces utiliza lo siguiente:
Sub GetShapeFromWeb(strShpUrl As String, rngTarget As Range)
'Act.Por.Dante Amor
With rngTarget.Parent
Set img = .Pictures.Insert(strShpUrl)
'.Shapes(.Shapes.Count).Left = rngTarget.Left
'.Shapes(.Shapes.Count).Top = rngTarget.Top
End With
Set r = Range("B9:B12")
With img
.Placement = xlMoveAndSize
.ShapeRange.LockAspectRatio = msoFalse
.Top = r.Top + 1
.Left = r.Left + 1
.Width = r.Width - 2
.Height = r.Height - 2
End With
End Sub
'
Sub Obtener_imagen()
On Error Resume Next
i = 9
Call GetShapeFromWeb(Range("AY" & i).Value, Hoja1.Range("a65536").End(xlUp).Offset(i - 1, 0))
End SubPara que se ejecute en automático cuando cambias el valor de la celda. Pon la siguiente macro en los eventos de tu hoja:
Private Sub Worksheet_Change(ByVal Target As Range)
'Por.Dante Amor
If Target.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("AY9")) Is Nothing Then
Call Obtener_imagen
End If
End SubCambia en la macro AY9 por la celda que modificas para que se ejecute la macro.
Sigue las Instrucciones para poner la macro en los eventos de worksheet
- Abre tu libro de excel
- Para abrir Vba-macros y poder pegar la macro, Presiona Alt + F11
- Del lado izquierdo dice: VBAProject, abajo dale doble click a worksheet(tu hoja)
- En el panel del lado derecho copia la macro
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias