VBA Excel - Вставить картинку с URL - Окно учетных данных

Question

У меня есть макрос, настроенный для навигации по веб-сайту и очистки данных + изображений для создания списка сравнения продуктов.Небольшая проблема, с которой я сталкиваюсь, заключается в том, что при попытке вставить изображение с помощью VBA иногда появляется окно с запросом безопасности Windows для вставки данных для входа.Если я отменяю окно, код работает правильно, но это всплывающее окно для каждого продукта в диапазоне из 50 наименований не является идеальным.

Я нашел несколько URL-адресов изображений, которые, кажется, вставляются без этого всплывающего окна.Показываю, что это связано с тем, насколько безопасным Microsoft видит сайт.Я также попробовал оба .Pictures.Insert и .Shapes.AddPicture.У обоих одинаковая проблема

Приведенный ниже код с использованием первой ссылки покажет окно входа, но если вы воспользуетесь второй ссылкой, оно будет работать без всплывающего окна

Sub DrawPicture()
Dim link As String
link = "https://2ecffd01e1ab3e9383f0-07db7b9624bbdf022e3b5395236d5cf8.ssl.cf4.rackcdn.com/Product-190x190/0e72ef05-691d-4b3b-b978-a1bb9929e372.jpg"
'link = "https://pbs.twimg.com/profile_images/54789364/JPG-logo-highres.jpg"
ActiveSheet.Pictures.Insert (link)
End Sub

Если кто-томог бы объяснить и предоставить решение этой проблемы, которое было бы замечательно

Answer 1

Попробуйте этот код

Sub Test()
Dim src         As String
Dim lfn         As String

src = "https://2ecffd01e1ab3e9383f0-07db7b9624bbdf022e3b5395236d5cf8.ssl.cf4.rackcdn.com/Product-190x190/0e72ef05-691d-4b3b-b978-a1bb9929e372.jpg"
lfn = ThisWorkbook.Path & "\Output.jpg"

If RequestDownload(src, lfn) Then
    Cells(1).Select
    ActiveSheet.Pictures.Insert lfn
End If
End Sub

Function RequestDownload(URL$, FILE$) As Boolean
Dim b()         As Byte
Dim f           As Integer

With CreateObject("WinHttp.WinHttpRequest.5.1")
    .Open "GET", URL, False
    .setRequestHeader "DNT", "1"
    On Error GoTo Fin
    .send

    If .Status = 200 Then
        b = .responseBody
        f = FreeFile(1)
        Open FILE For Binary As #f
        Put #f, , b
        Close #f
        RequestDownload = True
    End If
Fin:
End With
End Function

Answer 2

Вы пытались установить для параметра DisplayAlerts значение Flase?

Sub DrawPicture()
Dim link As String
link = "https://2ecffd01e1ab3e9383f0-07db7b9624bbdf022e3b5395236d5cf8.ssl.cf4.rackcdn.com/Product-190x190/0e72ef05-691d-4b3b-b978-a1bb9929e372.jpg"
'link = "https://pbs.twimg.com/profile_images/54789364/JPG-logo-highres.jpg"
Application.DisplayAlerts = False
ActiveSheet.Pictures.Insert (link)
Application.DisplayAlerts = True
End Sub