Excel VBA Picture Insert не работает - только для некоторых URL - PullRequest
0 голосов
/ 07 ноября 2018

Я использовал приведенный ниже код VBA для вставки изображений из URL-адреса изображения. По некоторым причинам этот код работает с некоторыми URL-адресами изображений, но не с другими.

Например, нижеуказанные URL будут работать

http://a.espncdn.com/combiner/i?img=/i/headshots/nfl/players/full/3123076.png&w=350&h=254

https://upload.wikimedia.org/wikipedia/commons/thumb/c/c8/David_Njoku_2018.jpg/220px-David_Njoku_2018.jpg

Но ниже не будет

http://ecx.images -amazon.com / изображения / I / 41HkOMYqc9L.SL500.jpg

http://ecx.images -amazon.com / изображения / I / 41gWzC% 2B5IqL.SL500.jpg

http://ecx.images -amazon.com / изображения / I / 41gWzC% 2B5IqL.SL500.jpg

Кто-нибудь знает, есть ли какие-либо ограничения для команды "ActiveSheet.Pictures.Insert"?

Ниже приведен код, который я использую

Sub URLPictureInsert()
    Dim Pshp As Shape
    Dim xRg As Range
    Dim xCol As Long
    On Error Resume Next
    Application.ScreenUpdating = False
    Set Rng = ActiveSheet.Range("A1 :A24")
    For Each cell In Rng
        filenam = cell
        ActiveSheet.Pictures.Insert(filenam).Select
        Set Pshp = Selection.ShapeRange.Item(1)
        If Pshp Is Nothing Then GoTo lab
        xCol = cell.Column + 1
        Set xRg = Cells(cell.Row, xCol)
        With Pshp
            .LockAspectRatio = msoFalse
            .Width = 100
            .Height = 100
            .Top = xRg.Top + (xRg.Height - .Height) / 2
            .Left = xRg.Left + (xRg.Width - .Width) / 2
        End With
lab:
    Set Pshp = Nothing
    Range("A1").Select
    Next
    Application.ScreenUpdating = True
End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...