prop. scale images - have code, just need slight mod

[cml0904]

Hi, I have a column of image urls and need to scale/size them in proportion. I have code below that works well, BUT, in order to keep the aspect ratio, I really need to choose height or width. Mostly this works, but sometimes there is a very tall, skinny image that scales down to a sliver.

This code also changes the line height to match the forced height of the images. Again, works well, but not for every case.

How can I accommodate the odd images?

One more question please, when I sort data, I guess the images are moving with their respective data, but they are floating, right? Is there a way to anchor them to their cell/row?

Thanks a lot,
Cindy

-----------------------
Sub InsertPics()
'
For Each Item In Selection ' Go through each row the user has selected...
ActiveSheet.Cells(Item.Row, 4).Select ' Select the cell in column 4
' Insert a picture using the address in column 6
ActiveSheet.Pictures.Insert(ActiveSheet.Cells(Item.Row, 6).Value).Select
Selection.ShapeRange.Height = 72# ' Set the picture width to 72 (one inch)
Selection.ShapeRange.LockAspectRatio = True
ActiveSheet.Rows(Item.Row).RowHeight = 72# ' Set the row height to 72 (one inch)
Next Item
Columns("D:D").ColumnWidth = 15 ' Set the column width to one inch
End Sub

[Tom Ogilvy]

Sub abc()
Dim aspectRT As Double
Dim nwWidth As Double
Dim shp As ShapeRange
Dim item As Range
Set item = Range("A6")
With ActiveSheet
Set shp = .Pictures.Insert(.Cells(item.Row, 6).Value).ShapeRange
End With
aspectRT = shp.Height / shp.Width
nwWidth = 72# / aspectRT
If nwWidth < 30 Then
' do what?
Else
shp.LockAspectRatio = True
shp.Height = 72# '
End If
End Sub

--
Regards,
Tom Ogilvy

"cml0904" <cml0904.2crav5_1155939309.8734@excelforum-nospam.com> wrote in
message news:cml0904.2crav5_1155939309.8734@excelforum-nospam.com...
>
> Hi, I have a column of image urls and need to scale/size them in
> proportion. I have code below that works well, BUT, in order to keep
> the aspect ratio, I really need to choose height or width. Mostly this
> works, but sometimes there is a very tall, skinny image that scales
> down to a sliver.
>
> This code also changes the line height to match the forced height of
> the images. Again, works well, but not for every case.
>
> How can I accommodate the odd images?
>
> One more question please, when I sort data, I guess the images are
> moving with their respective data, but they are floating, right? Is
> there a way to anchor them to their cell/row?
>
> Thanks a lot,
> Cindy
>
> -----------------------
> Sub InsertPics()
> '
> For Each Item In Selection ' Go through each row the user has
> selected...
> ActiveSheet.Cells(Item.Row, 4).Select ' Select the cell in column
> 4
> ' Insert a picture using the address in column 6
> ActiveSheet.Pictures.Insert(ActiveSheet.Cells(Item.Row,
> 6).Value).Select
> Selection.ShapeRange.Height = 72# ' Set the picture width to 72
> (one inch)
> Selection.ShapeRange.LockAspectRatio = True
> ActiveSheet.Rows(Item.Row).RowHeight = 72# ' Set the row height to
> 72 (one inch)
> Next Item
> Columns("D:D").ColumnWidth = 15 ' Set the column width to one inch
> End Sub
>
>
> --
> cml0904
> ------------------------------------------------------------------------
> cml0904's Profile:
> http://www.excelforum.com/member.php...o&userid=37730
> View this thread: http://www.excelforum.com/showthread...hreadid=573287
>