如何使用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保持原始圖像大小？

回答

相關問題