You've done it again Tom! Thanks millions.

"Tom Ogilvy" wrote:

Sub AdjustSize()
Dim oItem As Shape
Set rng = Range("A1:L30")
Set oItem = ActiveSheet.Shapes(1)
oItem.Top = 0
oItem.Left = 0
oItem.LockAspectRatio = True
oItem.Height = rng.Height
If oItem.Width rng.Width Then
oItem.Width = rng.Width
End If
End Sub

Worked for me. No distortion at all.

--
Regards,
Tom Ogilvy


"quartz" wrote:

Tom,

I like the direct approach, but unfortunately, it also distorts some of the
images - they are not uniform in size...

I got much better performance setting ScreenUpdating to false, but any
further ideas?

"Tom Ogilvy" wrote:

why not something like
set rng = Range("A1:L30") ' or whatever your range is

oitem.Height = rng.Height
oitem.Width = rng.Width

You can get the visible range with

set rng = Activewindow.VisibleRange

--
Regards,
Tom Ogilvy


"quartz" wrote:

I am using Office 2003 on Windows XP.

My code places a graphic on a spreadsheet in the upper left corner of the
screen. I need code that will resize this image so that it will be as large
as possible, yet not go off my visible range (row 30 by column 12) - please
note that this is only used by me so the size will be constant.

I wrote a sub to do this resizing, as shown below, however, this program
runs very slowly, I can see each incremental size change. I would have
expected this to run pretty fast. Does anyone have a function that will speed
this up?

Sub Test_Image_Resize_2()

Dim oItem As Picture
Dim lHigh As Long
Dim lWide As Long
Set oItem = Selection
Do
lHigh = oItem.Height - 1
lWide = oItem.Width - 1
oItem.Height = lHigh
oItem.Width = lWide
If oItem.BottomRightCell.Row <= 30 And oItem.BottomRightCell.Column <=
12 Then Exit Do
Loop
End Sub

Thanks much for your example code.