Magnify contents of cell when mousing over - is this possible?

[simon]

I'd like to add an effect to a spreadsheet where mousing over a cell
magnifys the contents.
Can this be done..?

Reason being I've got a large spread sheet that works like a planner...
however viewing it so that you get a decent look ahead means zooming out...
this makes the cell contents difficult to read..
hence I'd like to be able to drift the cursor over a cell and have the
contents magnify...

Thanks in advance for any help
Simon.

 

[Guest]

Hi Simon

Here's stuff to get you started:

http://exceltips.vitalnews.com/Pages/T1247_Magnifying_Only_the_Current_Cell.html

 

[NickHK]

The link provided by Wigi gives you some ideas.
If you just want the zoom function by mouse over a range, not selection, try
this. You will need the timer from
http://vb.mvps.org/samples/TimerObj

Whilst not a perfect solution as is, you can maybe improve it by setting the
cursor in the new range to avoid too much "flicker":

Option Explicit

Private Type POINTAPI
x As Long
y As Long
End Type

Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As
Long

Dim CursorPt As POINTAPI

Private Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y
As Long) As Long

Private WithEvents MyTimer As CTimer

'Change this as required
Const CheckRange As String = "M8:R21"

Private Const HIGHZOOM As Long = 200
Private Const LOWZOOM As Long = 100

Private Sub Worksheet_Activate()

If MyTimer Is Nothing Then Set MyTimer = New CTimer

With MyTimer
.Interval = 500
.Enabled = True
End With

End Sub

Private Sub Worksheet_Deactivate()

If Not MyTimer Is Nothing Then
With MyTimer
.Enabled = False
End With
End If

End Sub

Private Sub MyTimer_Timer()
Dim RetVal As Long
Dim CursorRange As Range

If Range(CheckRange).Parent.Name <> ActiveSheet.Name Then Exit Sub

With ActiveWindow
RetVal = GetCursorPos(CursorPt)

On Error Resume Next
Set CursorRange = .RangeFromPoint(CursorPt.x, CursorPt.y)
On Error GoTo 0

If Not CursorRange Is Nothing Then
If Application.Intersect(Range(CheckRange), CursorRange) Is Nothing
Then
.Zoom = LOWZOOM
Else
.Zoom = HIGHZOOM
End If
Else
.Zoom = LOWZOOM
End If
End With

End Sub

NickHK