Norman,

Thanks for your help, still have one problem.

I insert a picture. I then run a macro on it to shrink it to 1 tenth its
original size (so it doesn't cover my entire spreadsheet). I then assign
your Zoom macro to maginify it 10x when selected.

This all works fine until excel "compresses" or takes the detail out of the
picture after 10min or so of it sitting in its "smaller" state. I have
macros set up to enlarge all pictures before close and then shrink on open...
this works fine... so the file should be saving them in thier orginial
state... with complete detail. However if I do not select a picture for some
time excel just magically compresses it... annoying! Any work around that?

"Norman Jones" wrote:

Hi John,

You have exposed a bug in the code!

I suspect that you clicked a picture to
zoom it and then saved and closed the
file, before the RestorePicture routine
could be called. In consequence, when
the file is re-opened, the base size is the
previously zoomed size; the thus zoomed
picture will itself therefore be zoomed
with another click.

Successive repetitions of this scenario
will increase the base size of the picture
by a factor of 2^n, where n is the number
of save operations.

To overcome the problem, replace the
existing code as follows:

In a standard module, paste:

'===========
Option Explicit

Private myPic As Picture
Private dHeight As Double
Private dWidth As Double
Private RunWhen As Double
Private blStop As Boolean
Private Const cRunIntervalSecondi = 10 '\\ 10 sSeconds
Private Const cRunWhat = "RestorePicture"

'--------------
Public Sub Zoom_Pic()
Const ZoomFactor As Double = 2

If blStop Then
Exit Sub
End If

Set myPic = ActiveSheet.Pictures(Application.Caller)

With myPic
dWidth = .Width
dHeight = .Height
.Width = ZoomFactor * dWidth
.Height = ZoomFactor * dHeight
blStop = True
End With

RunWhen = Now + TimeSerial(0, 0, cRunIntervalSecondi)
Application.OnTime EarliestTime:=RunWhen, _
Procedu=cRunWhat, _
Schedule:=True
End Sub

'--------------
Public Sub RestorePicture()

If Not myPic Is Nothing Then
With myPic
.Width = dWidth
.Height = dHeight
End With
End If
blStop = False

End Sub
'<<==========

In the workbook's \thisWorkbook module
(see below), paste the following code:

'==========
Option Explicit

Private Sub Workbook_BeforeSave( _
ByVal SaveAsUI As Boolean, _
Cancel As Boolean)
Call RestorePicture
End Sub
'<<==========

This is event code and should be pasted
into the worksheets's code module (not a
standard module and not the workbook's
ThisWorkbook module):

Right-click the worksheet's tab |
Select 'View Code' from the menu
Paste the code
Alt-F11 to return to Excel.


Delete and replace the picture(s) and
save the file.





-----
Regards.
Norman


"John" wrote in message
...
Norman, thanks... one problem (different issue)... after saving the file
it
seems excel takes out some of the detail on the picture... and when I
enlarge
it... it seems fuzzy. Like I said it doesn't do it initailly but after a
save or 2 it kicks in...

How do I keep the full detail of my picture even after shrinking it down?