Добрый день. Есть макрос, который загружал картинки с сайта по ссылкам вида "http://www.*" [vba]
Код
Sub ВставитьКартинку(ByRef PicRange As Range, ByVal PicPath As String) On Error Resume Next Application.ScreenUpdating = False Dim ph As Picture Set ph = PicRange.Parent.Pictures.Insert(PicPath) ph.Top = PicRange.Top + 1: ph.Left = PicRange.Left + 5 ph.Placement = xlMoveAndSize End Sub
[/vba] Но сайт откуда успешно грузились картинки стал с протоколом https и картинки не грузятся. Возможно ли как-то обойти? как я понял буква s - означает шифрование данных, хотя в браузере по ссылке картинку выдает
Добрый день. Есть макрос, который загружал картинки с сайта по ссылкам вида "http://www.*" [vba]
Код
Sub ВставитьКартинку(ByRef PicRange As Range, ByVal PicPath As String) On Error Resume Next Application.ScreenUpdating = False Dim ph As Picture Set ph = PicRange.Parent.Pictures.Insert(PicPath) ph.Top = PicRange.Top + 1: ph.Left = PicRange.Left + 5 ph.Placement = xlMoveAndSize End Sub
[/vba] Но сайт откуда успешно грузились картинки стал с протоколом https и картинки не грузятся. Возможно ли как-то обойти? как я понял буква s - означает шифрование данных, хотя в браузере по ссылке картинку выдаетsboy
а если сначала сохранить ее на комп а потом в книгу?: [vba]
Код
#If Win64 Then #If VBA7 Then ' Windows x64, Office 2010 Declare PtrSafe Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" _ (ByVal pCaller As LongLong, ByVal szURL As String, ByVal szFileName As String, _ ByVal dwReserved As LongLong, ByVal lpfnCB As LongLong) As LongLong #Else ' Windows x64,Office 2003-2007 Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" _ (ByVal pCaller As LongLong, ByVal szURL As String, ByVal szFileName As String, _ ByVal dwReserved As LongLong, ByVal lpfnCB As LongLong) As LongLong #End If #Else #If VBA7 Then ' Windows x86, Office 2010 Declare PtrSafe Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" _ (ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, _ ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long #Else ' Windows x86, Office 2003-2007 Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" _ (ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, _ ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long #End If #End If
Sub d() Dim PicRange As Range, PicPath$, PicUrl$ Set PicRange = Selection PicUrl = "https://mdata.yandex.net/i?path=b1204070811_img_id8957096532163503439.jpeg&size=5" PicPath = ActiveWorkbook.Path & "\TempImage" DownloadFile PicUrl, PicPath ВставитьКартинку PicRange, PicPath Kill PicPath End Sub Sub ВставитьКартинку(ByRef PicRange As Range, ByVal PicPath As String) On Error Resume Next Application.ScreenUpdating = False Dim ph As Picture Set ph = PicRange.Parent.Pictures.Insert(PicPath) ph.Top = PicRange.Top + 1: ph.Left = PicRange.Left + 5 ph.Placement = xlMoveAndSize End Sub Function DownloadFile(url As String, FileName As String) DownloadFile = URLDownloadToFile(0, url, FileName, 0, 0) End Function
а если сначала сохранить ее на комп а потом в книгу?: [vba]
Код
#If Win64 Then #If VBA7 Then ' Windows x64, Office 2010 Declare PtrSafe Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" _ (ByVal pCaller As LongLong, ByVal szURL As String, ByVal szFileName As String, _ ByVal dwReserved As LongLong, ByVal lpfnCB As LongLong) As LongLong #Else ' Windows x64,Office 2003-2007 Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" _ (ByVal pCaller As LongLong, ByVal szURL As String, ByVal szFileName As String, _ ByVal dwReserved As LongLong, ByVal lpfnCB As LongLong) As LongLong #End If #Else #If VBA7 Then ' Windows x86, Office 2010 Declare PtrSafe Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" _ (ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, _ ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long #Else ' Windows x86, Office 2003-2007 Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" _ (ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, _ ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long #End If #End If
Sub d() Dim PicRange As Range, PicPath$, PicUrl$ Set PicRange = Selection PicUrl = "https://mdata.yandex.net/i?path=b1204070811_img_id8957096532163503439.jpeg&size=5" PicPath = ActiveWorkbook.Path & "\TempImage" DownloadFile PicUrl, PicPath ВставитьКартинку PicRange, PicPath Kill PicPath End Sub Sub ВставитьКартинку(ByRef PicRange As Range, ByVal PicPath As String) On Error Resume Next Application.ScreenUpdating = False Dim ph As Picture Set ph = PicRange.Parent.Pictures.Insert(PicPath) ph.Top = PicRange.Top + 1: ph.Left = PicRange.Left + 5 ph.Placement = xlMoveAndSize End Sub Function DownloadFile(url As String, FileName As String) DownloadFile = URLDownloadToFile(0, url, FileName, 0, 0) End Function
Победил! После одноразового запуска такой конструкции, выскочило окно с сертификатом сайта, после подтверждения, мой старый макрос стал работать. [vba]
Код
Sub ВставитьКартинку(ByRef PicRange As Range, ByVal PicPath As String) On Error Resume Next: Application.ScreenUpdating = False Set oXMLHTTP = CreateObject("MSXML2.XMLHTTP") With oXMLHTTP .setOption "SXH_OPTION_IGNORE_SERVER_SSL_CERT_ERROR_FLAGS", "SXH_SERVER_CERT_IGNORE_ALL_SERVER_ERRORS" .Open "GET", PicPath, False .send Dim ph As Picture: Set ph = PicRange.Parent.Pictures.Insert(PicPath) End With Set oXMLHTTP = Nothing ph.Top = PicRange.Top + 1: ph.Left = PicRange.Left + 5 ph.Placement = xlMoveAndSize End Sub
[/vba] взято по ссылке от _Boroda_, спасибо
Победил! После одноразового запуска такой конструкции, выскочило окно с сертификатом сайта, после подтверждения, мой старый макрос стал работать. [vba]
Код
Sub ВставитьКартинку(ByRef PicRange As Range, ByVal PicPath As String) On Error Resume Next: Application.ScreenUpdating = False Set oXMLHTTP = CreateObject("MSXML2.XMLHTTP") With oXMLHTTP .setOption "SXH_OPTION_IGNORE_SERVER_SSL_CERT_ERROR_FLAGS", "SXH_SERVER_CERT_IGNORE_ALL_SERVER_ERRORS" .Open "GET", PicPath, False .send Dim ph As Picture: Set ph = PicRange.Parent.Pictures.Insert(PicPath) End With Set oXMLHTTP = Nothing ph.Top = PicRange.Top + 1: ph.Left = PicRange.Left + 5 ph.Placement = xlMoveAndSize End Sub