How to keep original image size using vba?

Question

Basically I am writing a code that grabs image urls from a list, and outputs their size in a cell. It works for some of the links but not all. Could someone tell me why it is so?

Dim MyPic As Shape
Dim sht As Worksheet

Set sht = ActiveSheet


With sht
    For i = 2 To .Cells(.Rows.Count, "A").End(xlUp).Row
    If .Cells(i, 2) <> "" Then
        Set mypict = ActiveSheet.Shapes.AddPicture(.Cells(i, 2).Text, _
                msoFalse, msoTrue, 3, 3, -1, -1)

        'Set mypict = ActiveSheet.Pictures.Insert(.Cells(i, 2).Text)

        .Cells(i, 7) = mypict.Width & " x " & mypict.Height
        mypict.Delete
    End If
    Next i
End With

Best regards,

Francisco

Hm it's working for me. Can you share a URL or three where it's *not* working? — BruceWayne, May 12 '16 at 19:36
http://res.cloudinary.com/lo65iitez/image/upload/v1437773949/OMS/MHI-90102-YELLOW_full.jpg — Francisco Plácido, May 12 '16 at 19:40
You may like to have a look at a program code given by @David Zemens vide question url Sample results obtained are uploaded to drop box vide link Please look into it whether it meets your requirements.It takes care of size of image also by setting LockAspectRatio — skkakkar, May 12 '16 at 19:56
Hi thanks but that is not what I am looking for. @BruceWayne did you check the link I provided? — Francisco Plácido, May 13 '16 at 00:15
The link you gave worked for me. See this [screenshot](http://i.stack.imgur.com/DCS85.jpg). When it *doesn't* work for you, does it throw an error? Or does it just leave the cell blank? (Note: It did take a minute or two to get the data) — BruceWayne, May 13 '16 at 15:46
Yes it does work, but if you check it out, its not the correct size. thats my problem. — Francisco Plácido, May 13 '16 at 18:32
`AddPicture` has a parameter of size (width, height). If you don't want parameters : `Set mypict = ActiveSheet.Shapes.Insert(.Cells(i, 2).Text).Shaperange(1)`. Note that this method does not provide a `top` and `left`attrribute : so you can add a simple `with MyPict : .left=3 : .top= 3: end with` — Patrick Lepelletier, May 14 '16 at 08:24
Also, `with MyPict : .scalewidth 1# ,true, msoscalefromtopleft : .Scaleheight 1#, true, msofromtopleft: .lockaspectratio=msotrue: end with` — Patrick Lepelletier, May 14 '16 at 08:30
Patrick, how is that going to solve my problem? the parameters -1 -1 in size, make the picture become the original size — Francisco Plácido, May 14 '16 at 11:23

score 0 · Answer 1 · answered May 13 '16 at 16:25

As mentioned above, the code worked for me on the URL that was giving you an error.

However, here's an alternative code you can try. You'll probably need to tweak the loop/Cells, but otherwise is pretty straightforward:

Sub extract()
Dim i&, lastRow&
lastRow = Cells(Rows.Count, 1).End(xlUp).Row

For i = 2 To lastRow

    Dim IE As InternetExplorer
    Dim html As HTMLDocument

    Set IE = New InternetExplorer
    IE.Visible = False
    IE.navigate Cells(i, 2).Value

    ' Wait while IE loading
    Do While IE.Busy
        Application.Wait DateAdd("s", 1, Now)
    Loop

    Set html = IE.document

    Dim webImage As Variant
    Set webImage = html.getElementsByTagName("img")

    Debug.Print "Image is " & webImage(0).Width & " x " & webImage(0).Height
    Cells(i, 2).Offset(0, 1).Value = webImage(0).Width & " x " & webImage(0).Height
    'Cleanup
    IE.Quit
    Set IE = Nothing
Next i

End Sub

(Credit goes to @PortlandRunner for the main code). Note that you'll need two reference libraries:

Microsoft Internet Controls
Microsoft HTML Object Library

please check my other comment – Francisco Plácido May 13 '16 at 18:36 — Francisco Plácido, May 13 '16 at 18:36

How to keep original image size using vba?

1 Answers1