scroll window to display selected cell in visible area?

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

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

--
Regards,
Tom Ogilvy

"Kate" <eppstein@wmich.edu> wrote in message
news:%23$XmaA9BGHA.1028@TK2MSFTNGP11.phx.gbl...
> 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, that's perfect!! You are a magician! Thank you so much,
Kate

Tom Ogilvy wrote:
> 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,

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 :

> 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

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 tried Tom's code but it failed if you select the last cell of the
> scrollarea.
>
>

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


keepITcool wrote:
> 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
>
>