bobomi

Sub Q_9822003045()

Dim obj(1)

If Pictures.Count <= 1 Then Exit Sub
Set obj(1) = Pictures(1)
For Each obj(0) In Pictures
  If (obj(0).Width * obj(0).Height) > _
     (obj(1).Width * obj(1).Height) Then
      Set obj(1) = obj(0)
  End If
Next

For Each obj(0) In Pictures
  If obj(0).Name <> obj(1).Name Then
     obj(0).Delete
  End If
Next

End Sub