Insert images by url

[YasserKhalil]

Hello everyone
I am trying to insert images in column F by urls in column C

Code: Select all

Sub Insert_Images_By_URL()
    Dim sURL As String, lr As Long, r As Long
    With ActiveSheet
        lr = .Cells(.Rows.Count, "F").End(xlUp).Row
        For r = 1 To lr
            With .Cells(r, "F")
                If .Value <> Empty Then
                    sURL = "https://logo.clearbit.com/" & .Offset(, -3).Value & ".com"
                    With .Parent.Pictures.Insert(sURL)
                        .ShapeRange.LockAspectRatio = msoTrue
                        .Top = .Top
                        .Left = .Left
                        .Width = .Width
                        .Height = .Height
                    End With
                End If
            End With
        Next r
    End With
End Sub

I can get the images downloaded but not in cells of column F. How can I get them inserted correctly and be fit to the cells themselves?

[HansV]

How about

Code: Select all

Sub Insert_Images_By_URL()
    Dim sURL As String, lr As Long
    Dim c As Range
    With ActiveSheet
        lr = .Cells(.Rows.Count, "F").End(xlUp).Row
        For Each c In Range("F1:F" & lr)
            If c.Value <> Empty Then
                sURL = "https://logo.clearbit.com/" & c.Offset(, -3).Value & ".com"
                 With .Pictures.Insert(sURL)
                    .ShapeRange.LockAspectRatio = msoTrue
                    .Top = c.Top
                    .Left = c.Left
                    If .Width / .Height > c.Width / c.Height Then
                        .Width = c.Width
                    Else
                        .Height = c.Height
                    End If
                End With
            End If
        Next c
    End With
End Sub

I adjusted the code to fit the image into the cell.

[YasserKhalil]

Amazing my tutor. Now the images are inserted somewhat correctly in column F cells but not fitted properly according to the same height and width of the target cells.

[HansV]

If you want them to fit the cell exactly, they will be distorted (stretched or compressed). If that is OK, use

Code: Select all

Sub Insert_Images_By_URL()
    Dim sURL As String, lr As Long
    Dim c As Range
    With ActiveSheet
        lr = .Cells(.Rows.Count, "F").End(xlUp).Row
        For Each c In Range("F1:F" & lr)
            If c.Value <> Empty Then
                sURL = "https://logo.clearbit.com/" & c.Offset(, -3).Value & ".com"
                With .Pictures.Insert(sURL)
                    .ShapeRange.LockAspectRatio = msoFalse
                    .Top = c.Top
                    .Left = c.Left
                    .Width = c.Width
                    .Height = c.Height
                End With
            End If
        Next c
    End With
End Sub

[YasserKhalil]

Wonderful. Thank you very much.