vbaを使用して元の画像サイズを保持する方法は？

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に行きます）。あなたは二つの基準のライブラリが必要になりますことに注意してください：

1. マイクロソフトのインターネットでは、それは私のために働いて
2. のMicrosoft HTMLオブジェクトライブラリ