Slow code

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.

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.

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.

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.

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.

Try turning screen updating off. it may just take a while cause it is
waiting for your video card to paint each change
(application.screeenupdating = false) be sure to turn it back on at
the end of the sub

HTH

AR

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.