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:A4") 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 ...
