Solved: Zooming cells to original Zoom?

[Simon Lloyd]

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!
[VBA]
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
[/VBA]

[Simon Lloyd]

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
[vba]Range("A" & ActiveCell.Row).Select
[/vba] for this one[vba]ActiveWindow.LargeScroll ToRight:=-1[/vba]it 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]

Simon,

Try this

[vba]

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
[/vba]

[Simon Lloyd]

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]

Try
[vba]
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
[/vba]

[Simon Lloyd]

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]

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]

Try playing around with ScrollRow values
[VBA]
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
[/VBA]

[Bob Phillips]

I think it is the merged cells

[vba]


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
[/vba]

[Simon Lloyd]

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]

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?

[vba]

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
[/vba]

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

Just replied to that.

[Simon Lloyd]

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]

Insufficient tested Simon, testing F & J but not B. Tut tut, I always tell people to at least test the bounds!

[vba]

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
[/vba]

[Simon Lloyd]

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]

Yeah, note the constants at the head of the code, you can adjust them to give the appearance you want.

[Simon Lloyd]

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
[VBA]nRowOff = IIf(Target.Row + RowOffset < 1, -1, RowOffset)
[/VBA]could you do a couple of things?, firstly why did it halt the code and secondly what is [VBA]IIf[/VBA] after the = as i didn't see a declaration for it?

Regards,
Simon

[Prasad_Joshi]

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]

Simon,

You are a typical user, always shifting the requirements .

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]

<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]

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 .

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