1

I've written a script in vba which uses Url in column b and insert the image in column c right next to the url. The script works when I use this image link but it fails when I use this image link. How can make my script do the trick even when I use the second link?

This is my try so far:

Sub InsertImages()
    Dim pics$, myPics As Shape, PicExists As Boolean, cel As Range

    For Each cel In Range("C2", Range("B2").End(xlDown).Offset(0, 1))
        PicExists = False
        pics = cel.Offset(0, -1)

        For Each myPics In ActiveSheet.Shapes
            If myPics.TopLeftCell.Row = cel.Row Then PicExists = True: Exit For
        Next myPics

        If Not PicExists Then
            With ActiveSheet.Pictures.Insert(pics)
                .ShapeRange.LockAspectRatio = msoFalse
                .Width = cel.Width
                .Height = cel.Height
                .Top = Rows(cel.Row).Top
                .Left = Columns(cel.Column).Left
            End With
        End If
    Next cel
End Sub

Post script: Although my above script can insert picture making use of the first link, the image looks quite different from the source. To be clearer: the image becomes fatty.

QHarr
  • 83,427
  • 12
  • 54
  • 101
SIM
  • 21,997
  • 5
  • 37
  • 109

1 Answers1

1

(1) It seems that it is not possible to copy an image from amazon server with .picures.insert - this is probably because of Amazon, not Excel. However, downloading it as ADODB.Stream works, so that may be a work around. I made a test with the code from This answer and it worked.

(2) You explicitly set position and size of the image to an Excel cell and demands that the AspectRatio is not to be kept. If you set this to True, Excel automatically keeps the ratio between width and height - so changing the width will automatically also change the heigth (or vice versa).

If you want to keep the original size of the image, remove the lines that sets width and hight of the image:

With ActiveSheet.Pictures.Insert(pics)
   .ShapeRange.LockAspectRatio = msoTrue
   .Top = Rows(cel.Row).Top
   .Left = Columns(cel.Column).Left
End With

If you want to resize the image so that it fits into the cell:

With ActiveSheet.Pictures.Insert(pics)
    .ShapeRange.LockAspectRatio = msoTrue
    .Top = Rows(cel.Row).Top
    .Left = Columns(cel.Column).Left
    If .Width / .Height > cel.Width / cel.Height Then
        .Width = cel.Width
    Else
        .Height = cel.Height
    End If
End With
FunThomas
  • 23,043
  • 3
  • 18
  • 34
  • Will surely get back to you with any feedback. Thanks a lot @FunThomas. – SIM Aug 22 '18 at 08:29
  • If I download the picture, how can I insert them right next to the concerning cell. Your second suggestion works for other links. The pictures are no longer fatty. However, they do not fit to the cell either (very small in size now). Provided plus one. Thanks. – SIM Aug 22 '18 at 08:52
  • When you have downloaded a pic, just use `Pictures.Insert`, but instead of the url, give the file name of your stored image file as parameter – FunThomas Aug 22 '18 at 09:06
  • 1
    For the image size: You have to make up your mind how you want to display the image. I see three possibilities: **(1)** Resize image so that it fits into cell **(2)** Resize Cell **(3)** Dont resize image or keep a minimum size, but live with the fact that the images may overlap. – FunThomas Aug 22 '18 at 09:10