PDA

View Full Version : Solved: Zooming cells to original Zoom?



Simon Lloyd
11-23-2006, 06:19 AM
Hi all,

I have adapted some code to zoom in when data validated cells are selected, the code works perfect, my only querie is how do i get excel to remember the original zoom setting in vba rather than a cell. At the moment i pass the value of the zoom to a cell that will never be used but doing this for every sheet made the size of the workbook grow greatly, is there a way of passing the value to a procedure or portion of memory so that when the user clicks away from the validated cell it zooms back to its original setting?

Regards,
Simon

Here's what i have!

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Dim OriginalZoom
OriginalZoom = ActiveWindow.Zoom
Range("A65536").Value = OriginalZoom
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Dim MyZoom As Long
Dim DV
Dim OriginalZoom
OriginalZoom = ActiveWindow.Zoom
MyZoom = 120
DV = 0
Application.EnableEvents = False
On Error Resume Next
DV = ActiveCell.Validation.Type
If DV = 3 Then
ActiveWindow.Zoom = MyZoom
ElseIf lDVType = 0 Then
ActiveWindow.Zoom = Range("A65536").Value
Range("A" & ActiveCell.Row).Select
End If
Application.EnableEvents = True
End Sub

Simon Lloyd
11-23-2006, 06:47 AM
Hi, this doesnt solve my querie but i just noticed that because of my code every time i click a cell i am transported to column A, this is because if i have a large worksheet after zooming then zooming out i had to scroll around to get the sheet back in position so i changed this line
Range("A" & ActiveCell.Row).Select
for this oneActiveWindow.LargeScroll ToRight:=-1it doesnt put the sheet back to the postion it was in but a bit friendlier than only being able to see half of the sheet or less.

Regards,
Simon

Bob Phillips
11-23-2006, 07:24 AM
Simon,

Try this



Private Sub Workbook_Open()
Dim sh As Worksheet
Dim this As Worksheet

Set this = ActiveSheet
For Each sh In ThisWorkbook.Worksheets
sh.Activate
ThisWorkbook.Names.Add Name:=sh.CodeName & "_Zoom", _
RefersTo:="=" & ActiveWindow.Zoom
Next sh
this.Activate
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal sh As Object, ByVal Target As Range)
Const MyZoom As Long = 120
Dim DV As Long
Dim OriginalZoom
OriginalZoom = ActiveWindow.Zoom
DV = 0
Application.EnableEvents = False
On Error Resume Next
DV = Target.Validation.Type
On Error GoTo 0
If DV = 3 Then
ActiveWindow.Zoom = 120
ElseIf DV = 0 Then
ActiveWindow.Zoom = Evaluate(ThisWorkbook.Names(sh.CodeName & "_Zoom").RefersTo)
End If
Application.EnableEvents = True
End Sub

Simon Lloyd
11-23-2006, 09:31 AM
Thanks for that Bob, when i first ran it i got Error Runtime 1004 but subsequent runs were ok, however, the code only seems to run on half the sheet!. So if i have dropdowns in columns B, E, F, H, K, P for example the zoom is only working when i select a validated cell in H, K and P (these arent the real areas just examples) any ideas why?.

I have attatched the workbook i'm working on.

Regards,
Simon

P.S sent you a PM a little while ago about power formula course?

mdmackillop
11-23-2006, 11:03 AM
Try

Option Explicit

Dim OriginalZoom As Long
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
OriginalZoom = ActiveWindow.Zoom
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Dim MyZoom As Long, DV As Long, lDVType As Long
MyZoom = 120
DV = 0
Application.EnableEvents = False
On Error Resume Next
DV = ActiveCell.Validation.Type
If DV = 3 Then
ActiveWindow.Zoom = MyZoom
ElseIf lDVType = 0 Then
ActiveWindow.Zoom = OriginalZoom
Range("A" & ActiveCell.Row).Select
End If
Application.EnableEvents = True
End Sub

Simon Lloyd
11-23-2006, 11:14 AM
Thanks Malcom that seems to work fine, as an added querie is it possible to focus on the selected validated cell while zooming?, i ask this because when i just zoomed to a cell to the bottom right of the worksheet it zoomed to the middle of the cell at the bottom right i.e the dropdown arrow was out of sight just of the screen, therefore the user has to scroll to use the arrow. I know its probably a mile away from what i first was trying to achieve but i suppose the "wouldn't it be nice....." scenario would be to have the selected cell focused to centre screen and then all back to normal when clicking any cell not validated.

What do you think?

Regards,
Simon

Simon Lloyd
11-23-2006, 11:24 AM
Malcom there was a typo in my code that you adapted lDVType should have read DV, i changed this and i can view the dropdown arrow, however the "Wouldn't it be nice" scenario would still be nice!!

Regards,
Simon

mdmackillop
11-23-2006, 11:41 AM
Try playing around with ScrollRow values

If DV = 3 Then
ActiveWindow.Zoom = MyZoom
ActiveWindow.ScrollRow = Target.Row - 3
ActiveWindow.ScrollColumn = Target.Column - 3
ElseIf DV = 0 Then
ActiveWindow.Zoom = OriginalZoom
ActiveWindow.ScrollRow = Target.Row - 3
Range("A" & ActiveCell.Row).Select
End If

Bob Phillips
11-23-2006, 11:49 AM
I think it is the merged cells




Private Sub Workbook_Open()
Dim Sh As Worksheet
Dim this As Worksheet

Set this = ActiveSheet
For Each Sh In ThisWorkbook.Worksheets
Sh.Activate
ThisWorkbook.Names.Add Name:=Sh.CodeName & "_Zoom", _
RefersTo:="=" & ActiveWindow.Zoom
Next Sh
this.Activate
End Sub

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
ActiveWindow.Zoom = Evaluate(ThisWorkbook.Names(Sh.CodeName & "_Zoom").RefersTo)
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Const MyZoom As Long = 120
Dim DV As Long
Dim OriginalZoom
OriginalZoom = ActiveWindow.Zoom
DV = 0
Application.EnableEvents = False
Application.ScreenUpdating = False
On Error Resume Next
DV = Target.Cells(1, 1).Validation.Type
On Error GoTo 0
If DV = 3 Then
ActiveWindow.Zoom = 120
ElseIf DV = 0 Then
ActiveWindow.Zoom = Evaluate(ThisWorkbook.Names(Sh.CodeName & "_Zoom").RefersTo)
End If
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

Simon Lloyd
11-23-2006, 12:01 PM
Bob, thanks!, that works, i am able to select any of the dropdowns, zoom occurs and then zooms back out when clicking away, it also takes into account leaving the worksheet before clicking away (previous versions would leave it zoomed so the new value of OriginalZoom would have been either 100 or 120). The only problem i find with your version of zoom is as described above the selected validated cell is off the right hand edge of the screen if it was one of the last few columns i selected!

Is there a way to Set Focus to the selected cell?

Regards,
Simon.

P.S I'm still interested in your course!

Bob Phillips
11-23-2006, 12:16 PM
Bob, thanks!, that works, i am able to select any of the dropdowns, zoom occurs and then zooms back out when clicking away, it also takes into account leaving the worksheet before clicking away (previous versions would leave it zoomed so the new value of OriginalZoom would have been either 100 or 120). The only problem i find with your version of zoom is as described above the selected validated cell is off the right hand edge of the screen if it was one of the last few columns i selected!

Is there a way to Set Focus to the selected cell?
How about this Simon?



Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Const MyZoom As Long = 120
Const ColOffset As Long = -2 'adjust to suit
Const RowOffset As Long = -2 'adjust to suit
Dim DV As Long
Dim OriginalZoom
OriginalZoom = ActiveWindow.Zoom
DV = 0
Application.EnableEvents = False
Application.ScreenUpdating = False
On Error Resume Next
DV = Target.Cells(1, 1).Validation.Type
On Error GoTo 0
If DV = 3 Then
ActiveWindow.Zoom = 120
Application.Goto reference:=Target.Offset(RowOffset, ColOffset), Scroll:=True
Application.Goto reference:=Target
ElseIf DV = 0 Then
ActiveWindow.Zoom = Evaluate(ThisWorkbook.Names(Sh.CodeName & "_Zoom").RefersTo)
Application.Goto reference:=Sh.Range("A1"), Scroll:=True
End If
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub



P.S I'm still interested in your course!
Just replied to that.

Simon Lloyd
11-23-2006, 12:32 PM
Bob, thats fair enough it scrolls to the selection (more or less) but if i choose the first merged cells (nearly al validated cells are merged) in column B,C the i get runtime error 1004 application defined or object defined error!

Any ideas?

What am i saying i know you have ideas otherwise i wouldnt have had the responses!

I mean whats the matter with it?

Lol

Simon

Bob Phillips
11-23-2006, 12:45 PM
Insufficient tested Simon, testing F & J but not B. Tut tut, I always tell people to at least test the bounds!



Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Const MyZoom As Long = 120
Const ColOffset As Long = -2 'adjust to suit
Const RowOffset As Long = -2 'adjust to suit
Dim nColOff As Long, nRowOff As Long
Dim DV As Long
Dim OriginalZoom
OriginalZoom = ActiveWindow.Zoom
DV = 0
Application.EnableEvents = False
Application.ScreenUpdating = False
On Error Resume Next
DV = Target.Cells(1, 1).Validation.Type
On Error GoTo 0
If DV = 3 Then
ActiveWindow.Zoom = 120
nRowOff = IIf(Target.Row + RowOffset < 1, -1, RowOffset)
nColOff = IIf(Target.Column + ColOffset < 1, -1, ColOffset)
Application.Goto reference:=Target.Offset(nRowOff, nColOff), Scroll:=True
Application.Goto reference:=Target
ElseIf DV = 0 Then
ActiveWindow.Zoom = Evaluate(ThisWorkbook.Names(Sh.CodeName & "_Zoom").RefersTo)
Application.Goto reference:=Sh.Range("A1"), Scroll:=True
Application.Goto reference:=Target
End If
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

Simon Lloyd
11-23-2006, 02:24 PM
Bob that was "Bob" on! lol

no issues or problems, you have given me a lot to work with and the tools to adapt the coe a little further.

Thanks again.

Regards,
Simon

Bob Phillips
11-23-2006, 04:43 PM
Yeah, note the constants at the head of the code, you can adjust them to give the appearance you want.

Simon Lloyd
11-24-2006, 02:15 AM
Hi Bob, guess i spoke too soon, after testing the code which worked fine i then locked all the cells that aren't going to be used, this caused the code to break with runtime 1004 error at this line
nRowOff = IIf(Target.Row + RowOffset < 1, -1, RowOffset)
could you do a couple of things?, firstly why did it halt the code and secondly what is IIf after the = as i didn't see a declaration for it?

Regards,
Simon

Prasad_Joshi
11-24-2006, 02:47 AM
Use savesetting method to store your value in Registry & Getsetting to get the value back. For that type Getsetting in VBA module & press F1 for help.

Prasad

Bob Phillips
11-24-2006, 02:54 AM
Simon,

You are a typical user, always shifting the requirements :devil2:.

I haven't reproduced the problem (which probably just means I have locked what you have). Can you post the workbook for me to see?

Thanks

Bob

Bob Phillips
11-24-2006, 04:12 AM
<snip>

what is Iif after the = as i didn't see a declaration for it?

Iif is a VBA function, it is the VBA equivalent of a worksheet IF, it evaluates an expression, the first argument, and returns the following values depending on success or failure of the evaluation. Whereas the worksheet IF returns the answer to a cell, VBA Iif returns it to a VBA, so it can be output using MsgBox, Print, or stored in a variable.

Simon Lloyd
11-24-2006, 04:44 AM
Ok Bob here is the workbook, i have only worked on shift1 page, all cells that will not be used are locked (there is no password), when you select a validated cell it causes a runtime error.


You are a typical user, always shifting the requirements :devil2:.Yes i am guilty!, of course i am still developing the workbook and didnt follow exactly what you were doing with the offsets, but i think i figured out that there has to be an unlocked cell above the validated cell for the code to work.

As another desire and development is it possible to get the select validated cell to flash or be coloured temporarily?

regards
simon

Bob Phillips
11-24-2006, 06:41 AM
Simon,

I am struggling with this. I did get the error at one point, but that was just randomly wandering about, and I haven't been able to reproduce it. Can you tell me what cell you are clicking on that creates the error?

What I don't understand is how the error happens, as you seem to have locked all cells except the DV cells. This has two implications, first that the error therefore shouldn't ever happen, and second, you cannot ever select any other cell so you never revert the zoom factor back to its original. Why do feel the need to protect the sheet?

Simon Lloyd
11-25-2006, 02:59 AM
Hi Bob, the first DV cell i selected was the merged cell B,C 9, i only locked the sheet because i dont want anyone adding any other data to the sheet, there are normal cells that are unlocked you will find these in the columns marked index or on the rows 13:17.

I did get the error on any other DV cell, however once the error had occurred i had to close the program and re-open in order to replicate the fault as it seems that excel lost the ability to run any more code after the error!

Regards,
Simon

P.S as i said earlier we dont seem to get the fault if the cell directly above the DV cell is unlocked, if there is a way if hiding all formulae and only allowing changes to the index cells and DV cells other than locking the sheet i would go for that, people here have a nasty habit of trying to IMPROVE! on the tools you have given them. Lol

Bob Phillips
11-25-2006, 04:38 AM
Simon,

Try this version, locking is protected, and the restart problem should be addressed.

BTW, if it were me, I would shade the cells that the users can input to, it would help them when in the zoomed mode.



Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)

Const MyZoom As Long = 100
Const ColOffset As Long = 9 '
Const RowOffset As Long = 10 '
Dim nColOff As Long, nRowOff As Long
Dim DV As Long

On Error GoTo wb_ssc_exit
Application.EnableEvents = False
Application.ScreenUpdating = False

DV = 0
On Error Resume Next
DV = Target.Cells(1, 1).Validation.Type
On Error GoTo 0

Sh.Unprotect
If DV = 3 Then
ActiveWindow.Zoom = 100
nRowOff = IIf(Target.Row - RowOffset < 1, 1, Target.Row - RowOffset)
nColOff = IIf(Target.Column - ColOffset < 1, 1, Target.Column - ColOffset)
Application.Goto reference:=Sh.Cells(nRowOff, nColOff), Scroll:=True
Application.Goto reference:=Target

ElseIf DV = 0 Then

ActiveWindow.Zoom = Evaluate(ThisWorkbook.Names(Sh.CodeName & "_Zoom").RefersTo)
With ActiveWindow
.ScrollRow = 1
.ScrollColumn = 1
End With
Application.Goto reference:=Target
End If
Sh.Protect

wb_ssc_exit:
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

Simon Lloyd
11-25-2006, 06:08 AM
El Xid...Thanks a title well earned, that works, at first glance of the code i did think that once unprotected the formulae would be visible but thats not the case!. If you wouldn't mind looking at the code below i found on the net, it uses the ontime method to flash a cells background which is what i would like to do because when the sheet is zoomed it can take a short while for you to find the DV cell you selected because of course it doesnt centre on the cell. I want to Call the procedure and flash the cell but as you can see it returns the cells colour back to None, i did try a couple of variations to preserve the cells original coulour when the timer is stopped but to no avail!


BTW, if it were me, I would shade the cells that the users can input to, it would help them when in the zoomed mode.
I did have some shading in these but when involving end users for information and criticism the majority found the sheet too busy with extra colours.


Public NextFlash As Double
Public Const FR As String = "Sheet1!A1"
Sub StartFlashing()
If Range(FR).Interior.ColorIndex = 3 Then
Range(FR).Interior.ColorIndex = xlColorIndexNone
Else
Range(FR).Interior.ColorIndex = 3
End If
NextFlash = Now + TimeSerial(0, 0, 1)
Application.OnTime NextFlash, "StartFlashing", , True
End Sub
Sub StopFlashing()
Range(FR).Interior.ColorIndex = xlColorIndexNone
Application.OnTime NextFlash, "StartFlashing", , False
End Sub
Regards,
Simon

Bob Phillips
11-25-2006, 09:14 AM
Yet another (the rugby is boring!).

Simon Lloyd
11-25-2006, 09:22 AM
Ok you win!

That last one was perfect!

Thank you very much.

Regards,
Simon