Question

基本上我正在编写一个代码，从列表中抓取图像URL，并在单元格中输出它们的大小。它适用于某些链接但不是全部。有人能告诉我为什么会这样吗？

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

致以最诚挚的问候，

旧金山

Answer 1

如上所述，代码对我提供了错误的URL。

但是，这是您可以尝试的替代代码。您可能需要调整循环/单元格，否则非常简单：

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

（来自@PortlandRunner的主要代码）。请注意，您需要两个参考库：

Microsoft Internet Controls
Microsoft HTML对象库

如何使用vba保持原始图像大小？

1 个答案: