View Single Post
  #6   Report Post  
Posted to microsoft.public.excel.programming
Kate Kate is offline
external usenet poster
 
Posts: 35
Default scroll window to display selected cell in visible area?

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