Norman Jones

[John]

Norman, in regards to your help yesterday on resizing pictures I have a
problem today as I have added more pictures. The code worked fine with one
or two but now it seems to occassionally "zoom" on a different picture from
the one selected... when clicking on each picture (each pic has the same
piece of code attached to it)


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 = 10

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
.BringToFront
blStop = True
End With

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

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

With myPic
.Width = dWidth
.Height = dHeight
End With

blStop = False

End Sub