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

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

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

最好的问候，

旧金山

来源

2016-05-12 Francisco Plácido

嗯它为我工作。你可以分享一个URL或三个地方它*不*工作？ – BruceWayne

http://res.cloudinary.com/lo65iitez/image/upload/v1437773949/OMS/MHI-90102-YELLOW_full.jpg –

您可能想看看@David Zemens提供的程序代码vide question url 获得的样本结果上传到下拉框视频链接请检查它是否符合您的要求。它通过设置LockAspectRatio照顾图像的大小 – skkakkar

如上所述，该代码为我工作的这是给你一个错误的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控制
Microsoft HTML对象库

来源

2016-05-13 16:25:53 BruceWayne

请检查我的其他评论 –

URL不会给我一个错误，它只是给出错误的结果.. –

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

回答

相关问题