scroll window to display selected cell in visible area?

[Kate]

Hi, does anyone have any good code for positioning the
window so that a cell which was selected via code will be in
the visible area? I have set the scrollarea for each tab on
my sheet, so I can't use the application.goto method to
position the selected cell at the upper left, if it's the
last cell in the scroll area range. This is part of a
validity check routine that looks for missing data. I'm
telling the user that the cursor is located where the
problem is, but it is often off-screen!! I'm using Excel
2003 sp1.

Thanks in advance,
Kate

 

[Tom Ogilvy]

Try something like this:

Sub AAAC()
Dim Target As Range, rng As Range
Set Target = Worksheets("Sheet3").Range("P70")
Application.Goto Target, True
Set rng = ActiveWindow.VisibleRange
If Intersect(rng, ActiveCell) Is Nothing Then
ActiveWindow.ScrollRow = _
Target.Offset(-rng.Rows.Count + 1).Row
Set rng = ActiveWindow.VisibleRange
If Intersect(rng, ActiveCell) Is Nothing Then
ActiveWindow.ScrollColumn = _
Target.Offset(0, -rng.Columns.Count + 1).Column
End If
End If
End Sub

 

[Kate]

Tom, that's perfect!! You are a magician! Thank you so much,
Kate

 

[keepITcool]

Kate,

I tried Tom's code but it failed if you select the last cell of the
scrollarea.


It should be easy, but as you found it isn't...

To complicate it further you even need API's
to get the PC's DPI settings for correct point measurements..
(on most systems it's 96/72 but just sometimes its 120/72,
why excel cant figure this out by itself is beyond me..)

I had fun.. but I like problems


Option Explicit

Private Declare Function GetDC Lib "user32" ( _
ByVal hwnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" ( _
ByVal hwnd As Long, ByVal hDC As Long) As Long
Private Declare Function GetDeviceCaps Lib "gdi32" ( _
ByVal hDC As Long, ByVal nIndex As Long) As Long

'test only
Declare Sub Sleep Lib "kernel32.dll" ( _
ByVal dwMilliseconds As Long)
Const DELAY = 1500&

Private Function dpiFactor(bVertical As Boolean) As Double
Dim lDC&
Static lPX&(-1 To 0)
If lPX(True) = 0 Then
lDC = GetDC(0)
lPX(True) = GetDeviceCaps(lDC, 88)
lPX(False) = GetDeviceCaps(lDC, 90)
lDC = ReleaseDC(0, lDC)
End If
dpiFactor = lPX(bVertical) / 72
End Function

Sub ScrollTo(Start As Boolean)
With ActiveCell
ActiveWindow.ScrollIntoView _
.Left * dpiFactor(False), _
.Top * dpiFactor(True), _
.Width, .Height, Start
End With
End Sub

Sub Test()
ActiveSheet.ScrollArea = "C1:F300"
With Range(ActiveSheet.ScrollArea)
.Cells(1, 1).Select
ScrollTo True
Sleep DELAY
.Cells(1, .Columns.Count).Select
ScrollTo False
Sleep DELAY
.Cells(.Rows.Count, .Columns.Count).Select
ScrollTo False
Sleep DELAY
.Cells(.Rows.Count, 1).Select
ScrollTo False
Sleep DELAY
.Cells(1, 1).Select
ScrollTo True
End With
End Sub


--
keepITcool
| www.XLsupport.com | keepITcool chello nl | amsterdam


Kate wrote :

 

[keepITcool]

Oops!

Tom's code works beautifully as long as cells within
the scrollarea are selected.
(it stops if the targetcell is outside the scrollarea,
easily repaired with an on error resume next)


My code is a tat too complex for the task.


--
keepITcool
| www.XLsupport.com | keepITcool chello nl | amsterdam


keepITcool wrote :

 

[Kate]

I, too, developed problems if the offset value was greater
than the remaining available area to move. I had to fiddle
with it, and ended up doing this on the one sheet where the
columns extended further than the viewable area:

Set r = ActiveWindow.VisibleRange
If Intersect(ActiveCell, r) Is Nothing Then
Select Case ActiveCell.Column
Case Is > r.Column
ActiveWindow.LargeScroll toright:=1
Case Is < r.Column
ActiveWindow.LargeScroll toleft:=1
End Select
End If
Set r = ActiveWindow.VisibleRange
If Intersect(r, ActiveCell) Is Nothing Then
Select Case ActiveCell.Row
Case Is > r.Row
ActiveWindow.LargeScroll down:=1
Case Is < r.Row
ActiveWindow.LargeScroll up:=1
End Select
End If