Sub LienImage()
For Each cel In Selection
cel.Offset(0, 1).Select
cel.Offset(0, 1).RowHeight = 200
cel.Offset(0, 1).ColumnWidth = 80
If URLValid(cel.Value) = 0 Or HttpExists(cel.Value) = 0 Then
cel.Offset(0, 1).Value = "Photo non dispo"
Else
Set Image = ActiveSheet.Pictures.Insert(cel.Value)
With Image
.ShapeRange.LockAspectRatio = msoTrue
.Width = cel.Offset(0, 1).Width
.Height = cel.Offset(0, 1).Height
.Left = cel.Offset(0, 1).Left
.Top = cel.Offset(0, 1).Top
End With
End If
Next cel
End Sub
Function URLValid(url As String) As Boolean
If InStr(url, "png") > 0 Then
URLValid = True
ElseIf InStr(url, "jpg") > 0 Then
URLValid = True
ElseIf InStr(url, "jpeg") > 0 Then
URLValid = True
ElseIf InStr(url, "bmp") > 0 Then
URLValid = True
Else
URLValid = False
End If
End Function
Function HttpExists(ByVal sURL As String) As Boolean
Dim oXHTTP As Object
Set oXHTTP = CreateObject("MSXML2.XMLHTTP")
On Error GoTo haveError
oXHTTP.Open "HEAD", sURL, False
oXHTTP.send
HttpExists = IIf(oXHTTP.Status = 200, True, False)
Exit Function
haveError:
Debug.Print Err.Description
HttpExists = False
End Function