URLPictureInsert in Excel

URLPictureInsert.vb

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("G4:G50")
    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
            If .Width > xRg.Width Then .Width = xRg.Width * 2 / 3
            If .Height > xRg.Height Then .Height = xRg.Height * 2 / 3
            .Top = xRg.Top + (xRg.Height - .Height) / 2
            .Left = xRg.Left + (xRg.Width - .Width) / 2
        End With
        ActiveSheet.Shapes.AddPicture Filename:=filenam, linktofile:=msoFalse, _
              savewithdocument:=msoCTrue, Left:=Pshp.Left, Top:=Pshp.Top, Width:=Pshp.Width, Height:=Pshp.Height
        Pshp.Delete
lab:
        Set Pshp = Nothing
        Range("G4").Select
    Next
    Application.ScreenUpdating = True
End Sub