ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   picture resize (https://www.excelbanter.com/excel-programming/411887-picture-resize.html)

John

picture resize
 
I would like to have a macro that when run on a selected picture it enlarges
its size and then when unselected resizes smaller...

There will be several pictures in the worksheet that I would like to run the
same code on...

Any help is appreciated

Norman Jones[_2_]

picture resize
 
Hi John,

Right-click each of the pictures and
assign it to thwe macro: Zoom_Pic.

In a standard module, at the head of
the module, before any other procedures
paste the following code:

'===========
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()

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

blStop = False

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

As written, the code zooms the clicked picture
end restores the picture to its original dimensions
after 10 seconds.

The zoom factor may be changed by
modifying the value of the ZoomFactor
constant; the current value of 2 doubles t
he size of the original picture.

The time interval (in seconds) is controlled
by the Public constant cRunIntervalSecondi.



---
Regards.
Norman

"John" wrote in message
...
I would like to have a macro that when run on a selected picture it
enlarges
its size and then when unselected resizes smaller...

There will be several pictures in the worksheet that I would like to run
the
same code on...

Any help is appreciated



John

picture resize
 
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?

"Norman Jones" wrote:

Hi John,

Right-click each of the pictures and
assign it to thwe macro: Zoom_Pic.

In a standard module, at the head of
the module, before any other procedures
paste the following code:

'===========
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()

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

blStop = False

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

As written, the code zooms the clicked picture
end restores the picture to its original dimensions
after 10 seconds.

The zoom factor may be changed by
modifying the value of the ZoomFactor
constant; the current value of 2 doubles t
he size of the original picture.

The time interval (in seconds) is controlled
by the Public constant cRunIntervalSecondi.



---
Regards.
Norman

"John" wrote in message
...
I would like to have a macro that when run on a selected picture it
enlarges
its size and then when unselected resizes smaller...

There will be several pictures in the worksheet that I would like to run
the
same code on...

Any help is appreciated




Norman Jones[_2_]

picture resize
 
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?




John

picture resize
 
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?





John

picture resize
 
http://office.microsoft.com/en-us/he...2001033.aspx#2

think this works...

"John" wrote:

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?






All times are GMT +1. The time now is 07:28 AM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com