Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 2,253
Default Code to get a Range RECTangle or PT


FYI & FWIW,

It's easy to get a RangeFromPoint but to get the RECT or POINTAPI for a
range is far less straightforward.

I've had a look at Chip Pearson's FormPositioning demo. No luck there.
His code is struggling when he must determine the range's rectangle.
It comes close, but is not exact (look closely and it's off by a few
pixels) and it doesnt take much to throw his code offtrack by inches.
Use outlines...,Use zoom...Use a 120 DPI monitor setting.. oops again.

He's adjusting left and top for commandbars caption heights etc, but
missed the trick!

I've googled but couldn't find how it should be done.
So I tried .. and tried.. and found the EXACT way to do it.

Basically it's very simple.
the cell's LEFT converted to pixels.
PLUS
application.screenpixelsX(0).. to give you the starting PT.X of the
'clientrect'

et voila!

I wrapped it in a sub rather then a function to be compatible with api
syntax (plus for the purists.. it's slightly faster).

Option Explicit
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type

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 GetSystemMetrics Lib "user32.dll" ( _
ByVal nIndex As Long) As Long
Private Declare Function GetDeviceCaps Lib "gdi32" ( _
ByVal hDC As Long, ByVal nIndex As Long) As Long
Private Declare Function GetCurrentThreadId Lib "kernel32" ( _
) As Long

'additional for demo only
Private Declare Function SetCursorPos Lib "user32.dll" ( _
ByVal x As Long, ByVal y As Long) As Long
Private Declare Sub Sleep Lib "kernel32.dll" ( _
ByVal dwMilliseconds As Long)

Private Function ScreenDPI(bVert As Boolean) As Long
'in most cases this simply returns 96
Static lDPI&(1), lDC&
If lDPI(0) = 0 Then
lDC = GetDC(0)
lDPI(0) = GetDeviceCaps(lDC, 88&) 'horz
lDPI(1) = GetDeviceCaps(lDC, 90&) 'vert
lDC = ReleaseDC(0, lDC)
End If
ScreenDPI = lDPI(Abs(bVert))
End Function

Private Function PTtoPX(Points As Single, bVert As Boolean) As Long
PTtoPX = Points * ScreenDPI(bVert) / 72
End Function

Sub GetRangeRect(ByVal rng As Range, ByRef rc As RECT)
Dim wnd As Window

'requires additional code to verify the range is visible
'etc.

Set wnd = rng.Parent.Parent.Windows(1)
With rng
rc.Left = PTtoPX(.Left * wnd.Zoom / 100, 0) _
+ wnd.PointsToScreenPixelsX(0)
rc.Top = PTtoPX(.Top * wnd.Zoom / 100, 1) _
+ wnd.PointsToScreenPixelsY(0)
rc.Right = PTtoPX(.Width * wnd.Zoom / 100, 0) _
+ rc.Left
rc.Bottom = PTtoPX(.Height * wnd.Zoom / 100, 1) _
+ rc.Top
End With

End Sub

Sub Demo()
Dim rc As RECT
With ActiveWindow
.ScrollRow = 500
.ScrollColumn = 26
Range("ab510").Select
End With

MsgBox "Watch the mousecursor.. press CTRLBREAK to cancel"
Application.EnableCancelKey = xlErrorHandler
On Error GoTo done

Call GetRangeRect(ActiveCell, rc)
Do
DoEvents
Call SetCursorPos(rc.Left, rc.Top)
Call Sleep(200)
Call SetCursorPos(rc.Right, rc.Top)
Call Sleep(200)
Call SetCursorPos(rc.Right, rc.Bottom)
Call Sleep(200)
Call SetCursorPos(rc.Left, rc.Bottom)
Call Sleep(200)
Loop
done:

End Sub

--
keepITcool

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



  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 112
Default Code to get a Range RECTangle or PT

Nice one KeepITcool. One of those Eureka moments no doubt :-)

That's the first time I've seen anyone use the PointsToScreenPixelsX/Y
methods for anything useful.

You might be interested in the following post which describes a different
way of achieving the same result.

http://groups.google.com.au/group/mi...8664c24e1751e/

In my (perhaps biased) humble opinion, I think it's slightly better because
the algorithm you've shown fails when the sheet's zoom setting is < 100%. It
also fails with regards to split windows. Both algorithms fail with regards
frozen panes. :-(

Please don't get me wrong KeepITcool, I'm not trying to rain on your
parade. I think your contributions to this forum are some of the very best
and it's great to gain insight from people such as yourself who are so able
and willing to think for themselves.


Regards,
Vic Eldridge




"keepITcool" wrote:


FYI & FWIW,

It's easy to get a RangeFromPoint but to get the RECT or POINTAPI for a
range is far less straightforward.

I've had a look at Chip Pearson's FormPositioning demo. No luck there.
His code is struggling when he must determine the range's rectangle.
It comes close, but is not exact (look closely and it's off by a few
pixels) and it doesnt take much to throw his code offtrack by inches.
Use outlines...,Use zoom...Use a 120 DPI monitor setting.. oops again.

He's adjusting left and top for commandbars caption heights etc, but
missed the trick!

I've googled but couldn't find how it should be done.
So I tried .. and tried.. and found the EXACT way to do it.

Basically it's very simple.
the cell's LEFT converted to pixels.
PLUS
application.screenpixelsX(0).. to give you the starting PT.X of the
'clientrect'

et voila!

I wrapped it in a sub rather then a function to be compatible with api
syntax (plus for the purists.. it's slightly faster).

Option Explicit
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type

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 GetSystemMetrics Lib "user32.dll" ( _
ByVal nIndex As Long) As Long
Private Declare Function GetDeviceCaps Lib "gdi32" ( _
ByVal hDC As Long, ByVal nIndex As Long) As Long
Private Declare Function GetCurrentThreadId Lib "kernel32" ( _
) As Long

'additional for demo only
Private Declare Function SetCursorPos Lib "user32.dll" ( _
ByVal x As Long, ByVal y As Long) As Long
Private Declare Sub Sleep Lib "kernel32.dll" ( _
ByVal dwMilliseconds As Long)

Private Function ScreenDPI(bVert As Boolean) As Long
'in most cases this simply returns 96
Static lDPI&(1), lDC&
If lDPI(0) = 0 Then
lDC = GetDC(0)
lDPI(0) = GetDeviceCaps(lDC, 88&) 'horz
lDPI(1) = GetDeviceCaps(lDC, 90&) 'vert
lDC = ReleaseDC(0, lDC)
End If
ScreenDPI = lDPI(Abs(bVert))
End Function

Private Function PTtoPX(Points As Single, bVert As Boolean) As Long
PTtoPX = Points * ScreenDPI(bVert) / 72
End Function

Sub GetRangeRect(ByVal rng As Range, ByRef rc As RECT)
Dim wnd As Window

'requires additional code to verify the range is visible
'etc.

Set wnd = rng.Parent.Parent.Windows(1)
With rng
rc.Left = PTtoPX(.Left * wnd.Zoom / 100, 0) _
+ wnd.PointsToScreenPixelsX(0)
rc.Top = PTtoPX(.Top * wnd.Zoom / 100, 1) _
+ wnd.PointsToScreenPixelsY(0)
rc.Right = PTtoPX(.Width * wnd.Zoom / 100, 0) _
+ rc.Left
rc.Bottom = PTtoPX(.Height * wnd.Zoom / 100, 1) _
+ rc.Top
End With

End Sub

Sub Demo()
Dim rc As RECT
With ActiveWindow
.ScrollRow = 500
.ScrollColumn = 26
Range("ab510").Select
End With

MsgBox "Watch the mousecursor.. press CTRLBREAK to cancel"
Application.EnableCancelKey = xlErrorHandler
On Error GoTo done

Call GetRangeRect(ActiveCell, rc)
Do
DoEvents
Call SetCursorPos(rc.Left, rc.Top)
Call Sleep(200)
Call SetCursorPos(rc.Right, rc.Top)
Call Sleep(200)
Call SetCursorPos(rc.Right, rc.Bottom)
Call Sleep(200)
Call SetCursorPos(rc.Left, rc.Bottom)
Call Sleep(200)
Loop
done:

End Sub

--
keepITcool

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




  #3   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 2,253
Default Code to get a Range RECTangle or PT


I consider inserting a chart cheating :)

Repair for the zoom..
Sub GetRangeRect(ByVal rng As Range, ByRef RC As RECT)
Dim wnd As Window
'requires additional code to verify the range is visible
'etc.
Set wnd = rng.Parent.Parent.Windows(1)
With rng
RC.Left = PTtoPX(.Left, 0) * wnd.Zoom / 100 +
wnd.PointsToScreenPixelsX(0)
RC.Top = PTtoPX(.Top, 1) * wnd.Zoom / 100 +
wnd.PointsToScreenPixelsY(0)
RC.Right = PTtoPX(.Left + .Width, 0) * wnd.Zoom / 100 +
wnd.PointsToScreenPixelsX(0)
RC.Bottom = PTtoPX(.Top + .Height, 1) * wnd.Zoom / 100 +
wnd.PointsToScreenPixelsY(0)
End With
End Sub

I'll figure out the Split stuff later :)



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


Vic Eldridge wrote :

Nice one KeepITcool. One of those Eureka moments no doubt :-)

That's the first time I've seen anyone use the
PointsToScreenPixelsX/Y methods for anything useful.

You might be interested in the following post which describes a
different way of achieving the same result.

http://groups.google.com.au/group/mi....programming/b
rowse_frm/thread/1258664c24e1751e/

In my (perhaps biased) humble opinion, I think it's slightly better
because the algorithm you've shown fails when the sheet's zoom
setting is < 100%. It also fails with regards to split windows.
Both algorithms fail with regards frozen panes. :-(

Please don't get me wrong KeepITcool, I'm not trying to rain on your
parade. I think your contributions to this forum are some of the
very best and it's great to gain insight from people such as yourself
who are so able and willing to think for themselves.


Regards,
Vic Eldridge




"keepITcool" wrote:


FYI & FWIW,

It's easy to get a RangeFromPoint but to get the RECT or POINTAPI
for a range is far less straightforward.

I've had a look at Chip Pearson's FormPositioning demo. No luck
there. His code is struggling when he must determine the range's
rectangle. It comes close, but is not exact (look closely and it's
off by a few pixels) and it doesnt take much to throw his code
offtrack by inches. Use outlines...,Use zoom...Use a 120 DPI
monitor setting.. oops again.

He's adjusting left and top for commandbars caption heights etc, but
missed the trick!

I've googled but couldn't find how it should be done.
So I tried .. and tried.. and found the EXACT way to do it.

Basically it's very simple.
the cell's LEFT converted to pixels.
PLUS
application.screenpixelsX(0).. to give you the starting PT.X of the
'clientrect'

et voila!

I wrapped it in a sub rather then a function to be compatible with
api syntax (plus for the purists.. it's slightly faster).

Option Explicit
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type

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 GetSystemMetrics Lib "user32.dll" ( _
ByVal nIndex As Long) As Long
Private Declare Function GetDeviceCaps Lib "gdi32" ( _
ByVal hDC As Long, ByVal nIndex As Long) As Long
Private Declare Function GetCurrentThreadId Lib "kernel32" ( _
) As Long

'additional for demo only
Private Declare Function SetCursorPos Lib "user32.dll" ( _
ByVal x As Long, ByVal y As Long) As Long
Private Declare Sub Sleep Lib "kernel32.dll" ( _
ByVal dwMilliseconds As Long)

Private Function ScreenDPI(bVert As Boolean) As Long
'in most cases this simply returns 96
Static lDPI&(1), lDC&
If lDPI(0) = 0 Then
lDC = GetDC(0)
lDPI(0) = GetDeviceCaps(lDC, 88&) 'horz
lDPI(1) = GetDeviceCaps(lDC, 90&) 'vert
lDC = ReleaseDC(0, lDC)
End If
ScreenDPI = lDPI(Abs(bVert))
End Function

Private Function PTtoPX(Points As Single, bVert As Boolean) As Long
PTtoPX = Points * ScreenDPI(bVert) / 72
End Function

Sub GetRangeRect(ByVal rng As Range, ByRef rc As RECT)
Dim wnd As Window

'requires additional code to verify the range is visible
'etc.

Set wnd = rng.Parent.Parent.Windows(1)
With rng
rc.Left = PTtoPX(.Left * wnd.Zoom / 100, 0) _
+ wnd.PointsToScreenPixelsX(0)
rc.Top = PTtoPX(.Top * wnd.Zoom / 100, 1) _
+ wnd.PointsToScreenPixelsY(0)
rc.Right = PTtoPX(.Width * wnd.Zoom / 100, 0) _
+ rc.Left
rc.Bottom = PTtoPX(.Height * wnd.Zoom / 100, 1) _
+ rc.Top
End With

End Sub

Sub Demo()
Dim rc As RECT
With ActiveWindow
.ScrollRow = 500
.ScrollColumn = 26
Range("ab510").Select
End With

MsgBox "Watch the mousecursor.. press CTRLBREAK to cancel"
Application.EnableCancelKey = xlErrorHandler
On Error GoTo done

Call GetRangeRect(ActiveCell, rc)
Do
DoEvents
Call SetCursorPos(rc.Left, rc.Top)
Call Sleep(200)
Call SetCursorPos(rc.Right, rc.Top)
Call Sleep(200)
Call SetCursorPos(rc.Right, rc.Bottom)
Call Sleep(200)
Call SetCursorPos(rc.Left, rc.Bottom)
Call Sleep(200)
Loop
done:

End Sub

--
keepITcool

www.XLsupport.com | keepITcool chello nl | amsterdam





  #4   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 2
Default Code to get a Range RECTangle or PT

Hi Sir this is Gio from Philippines...... it's my first time here in
this site... i am wondering how can i solve this problem in excel and please
help me.. I used excel 2000 in creating an inventory program in the hospital.
I used this excel inventorry program in our suppply room, i used one
worksheet per item. and i have almost 300 items in the supply room or almost
300 worksheets. I saved it as a template for all i know it is safer to save
it as template rather than saving it as ordinary excel files. The program was
working well, but not when i started linking(hyperlink) it from a certain
file that i always used. Then i have save it several times as a template but
i notice that the program malfuncitons, it doesnt compute the formulas i
created and some formulas are gone. Why is this happening. when i add some
items in the inventory it wouldnt add to the current balance, why is this
happening? Will you please help me, you wer the only people who can only
help me with this kind of problem......please....
  #5   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 2,253
Default Code to get a Range RECTangle or PT

Giovanny,

please start your own thread instead of replying to
the first message that pops up and asking something that's
totally offtopic.

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


Giovanni D via OfficeKB.com wrote :

Hi Sir this is Gio from Philippines...... it's my first time here in
this site...



  #6   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 1,080
Default Code to get a Range RECTangle or PT

Hi Vic:

I remember that post ... it was a few years ago IIRC. I thought it was
pretty ingenious then (and still do).

Nice to see you're still lurking here!

Regards,

Vasant

"Vic Eldridge" wrote in message
...
Nice one KeepITcool. One of those Eureka moments no doubt :-)

That's the first time I've seen anyone use the PointsToScreenPixelsX/Y
methods for anything useful.

You might be interested in the following post which describes a different
way of achieving the same result.

http://groups.google.com.au/group/mi...8664c24e1751e/

In my (perhaps biased) humble opinion, I think it's slightly better
because
the algorithm you've shown fails when the sheet's zoom setting is < 100%.
It
also fails with regards to split windows. Both algorithms fail with
regards
frozen panes. :-(

Please don't get me wrong KeepITcool, I'm not trying to rain on your
parade. I think your contributions to this forum are some of the very
best
and it's great to gain insight from people such as yourself who are so
able
and willing to think for themselves.


Regards,
Vic Eldridge




"keepITcool" wrote:


FYI & FWIW,

It's easy to get a RangeFromPoint but to get the RECT or POINTAPI for a
range is far less straightforward.

I've had a look at Chip Pearson's FormPositioning demo. No luck there.
His code is struggling when he must determine the range's rectangle.
It comes close, but is not exact (look closely and it's off by a few
pixels) and it doesnt take much to throw his code offtrack by inches.
Use outlines...,Use zoom...Use a 120 DPI monitor setting.. oops again.

He's adjusting left and top for commandbars caption heights etc, but
missed the trick!

I've googled but couldn't find how it should be done.
So I tried .. and tried.. and found the EXACT way to do it.

Basically it's very simple.
the cell's LEFT converted to pixels.
PLUS
application.screenpixelsX(0).. to give you the starting PT.X of the
'clientrect'

et voila!

I wrapped it in a sub rather then a function to be compatible with api
syntax (plus for the purists.. it's slightly faster).

Option Explicit
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type

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 GetSystemMetrics Lib "user32.dll" ( _
ByVal nIndex As Long) As Long
Private Declare Function GetDeviceCaps Lib "gdi32" ( _
ByVal hDC As Long, ByVal nIndex As Long) As Long
Private Declare Function GetCurrentThreadId Lib "kernel32" ( _
) As Long

'additional for demo only
Private Declare Function SetCursorPos Lib "user32.dll" ( _
ByVal x As Long, ByVal y As Long) As Long
Private Declare Sub Sleep Lib "kernel32.dll" ( _
ByVal dwMilliseconds As Long)

Private Function ScreenDPI(bVert As Boolean) As Long
'in most cases this simply returns 96
Static lDPI&(1), lDC&
If lDPI(0) = 0 Then
lDC = GetDC(0)
lDPI(0) = GetDeviceCaps(lDC, 88&) 'horz
lDPI(1) = GetDeviceCaps(lDC, 90&) 'vert
lDC = ReleaseDC(0, lDC)
End If
ScreenDPI = lDPI(Abs(bVert))
End Function

Private Function PTtoPX(Points As Single, bVert As Boolean) As Long
PTtoPX = Points * ScreenDPI(bVert) / 72
End Function

Sub GetRangeRect(ByVal rng As Range, ByRef rc As RECT)
Dim wnd As Window

'requires additional code to verify the range is visible
'etc.

Set wnd = rng.Parent.Parent.Windows(1)
With rng
rc.Left = PTtoPX(.Left * wnd.Zoom / 100, 0) _
+ wnd.PointsToScreenPixelsX(0)
rc.Top = PTtoPX(.Top * wnd.Zoom / 100, 1) _
+ wnd.PointsToScreenPixelsY(0)
rc.Right = PTtoPX(.Width * wnd.Zoom / 100, 0) _
+ rc.Left
rc.Bottom = PTtoPX(.Height * wnd.Zoom / 100, 1) _
+ rc.Top
End With

End Sub

Sub Demo()
Dim rc As RECT
With ActiveWindow
.ScrollRow = 500
.ScrollColumn = 26
Range("ab510").Select
End With

MsgBox "Watch the mousecursor.. press CTRLBREAK to cancel"
Application.EnableCancelKey = xlErrorHandler
On Error GoTo done

Call GetRangeRect(ActiveCell, rc)
Do
DoEvents
Call SetCursorPos(rc.Left, rc.Top)
Call Sleep(200)
Call SetCursorPos(rc.Right, rc.Top)
Call Sleep(200)
Call SetCursorPos(rc.Right, rc.Bottom)
Call Sleep(200)
Call SetCursorPos(rc.Left, rc.Bottom)
Call Sleep(200)
Loop
done:

End Sub

--
keepITcool

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






  #7   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 2,253
Default Code to get a Range RECTangle or PT


Update.. i'm getting there... :)

i have a PaneWalker... that walks the cursor around the
pixelperfect rectangles of the panes. (frozen & unfrozen,
multiple monitors..)

now fiddling with an alternative for ActivePane.Index
... need to get the pane.index if the activecell
is in a frozen "title pane"..

...THEN..
i hope that the Range & CellWalker follow logically from
what I've got sofar..

...pfff... it's like doing a bloody crypto!

<VBG

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


Vic Eldridge wrote :

Nice one KeepITcool. One of those Eureka moments no doubt :-)

That's the first time I've seen anyone use the
PointsToScreenPixelsX/Y methods for anything useful.

You might be interested in the following post which describes a
different way of achieving the same result.

http://groups.google.com.au/group/mi....programming/b
rowse_frm/thread/1258664c24e1751e/

In my (perhaps biased) humble opinion, I think it's slightly better
because the algorithm you've shown fails when the sheet's zoom
setting is < 100%. It also fails with regards to split windows.
Both algorithms fail with regards frozen panes. :-(

Please don't get me wrong KeepITcool, I'm not trying to rain on your
parade. I think your contributions to this forum are some of the
very best and it's great to gain insight from people such as yourself
who are so able and willing to think for themselves.


Regards,
Vic Eldridge




"keepITcool" wrote:


FYI & FWIW,

It's easy to get a RangeFromPoint but to get the RECT or POINTAPI
for a range is far less straightforward.

I've had a look at Chip Pearson's FormPositioning demo. No luck
there. His code is struggling when he must determine the range's
rectangle. It comes close, but is not exact (look closely and it's
off by a few pixels) and it doesnt take much to throw his code
offtrack by inches. Use outlines...,Use zoom...Use a 120 DPI
monitor setting.. oops again.

He's adjusting left and top for commandbars caption heights etc, but
missed the trick!

I've googled but couldn't find how it should be done.
So I tried .. and tried.. and found the EXACT way to do it.

Basically it's very simple.
the cell's LEFT converted to pixels.
PLUS
application.screenpixelsX(0).. to give you the starting PT.X of the
'clientrect'

et voila!

I wrapped it in a sub rather then a function to be compatible with
api syntax (plus for the purists.. it's slightly faster).

Option Explicit
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type

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 GetSystemMetrics Lib "user32.dll" ( _
ByVal nIndex As Long) As Long
Private Declare Function GetDeviceCaps Lib "gdi32" ( _
ByVal hDC As Long, ByVal nIndex As Long) As Long
Private Declare Function GetCurrentThreadId Lib "kernel32" ( _
) As Long

'additional for demo only
Private Declare Function SetCursorPos Lib "user32.dll" ( _
ByVal x As Long, ByVal y As Long) As Long
Private Declare Sub Sleep Lib "kernel32.dll" ( _
ByVal dwMilliseconds As Long)

Private Function ScreenDPI(bVert As Boolean) As Long
'in most cases this simply returns 96
Static lDPI&(1), lDC&
If lDPI(0) = 0 Then
lDC = GetDC(0)
lDPI(0) = GetDeviceCaps(lDC, 88&) 'horz
lDPI(1) = GetDeviceCaps(lDC, 90&) 'vert
lDC = ReleaseDC(0, lDC)
End If
ScreenDPI = lDPI(Abs(bVert))
End Function

Private Function PTtoPX(Points As Single, bVert As Boolean) As Long
PTtoPX = Points * ScreenDPI(bVert) / 72
End Function

Sub GetRangeRect(ByVal rng As Range, ByRef rc As RECT)
Dim wnd As Window

'requires additional code to verify the range is visible
'etc.

Set wnd = rng.Parent.Parent.Windows(1)
With rng
rc.Left = PTtoPX(.Left * wnd.Zoom / 100, 0) _
+ wnd.PointsToScreenPixelsX(0)
rc.Top = PTtoPX(.Top * wnd.Zoom / 100, 1) _
+ wnd.PointsToScreenPixelsY(0)
rc.Right = PTtoPX(.Width * wnd.Zoom / 100, 0) _
+ rc.Left
rc.Bottom = PTtoPX(.Height * wnd.Zoom / 100, 1) _
+ rc.Top
End With

End Sub

Sub Demo()
Dim rc As RECT
With ActiveWindow
.ScrollRow = 500
.ScrollColumn = 26
Range("ab510").Select
End With

MsgBox "Watch the mousecursor.. press CTRLBREAK to cancel"
Application.EnableCancelKey = xlErrorHandler
On Error GoTo done

Call GetRangeRect(ActiveCell, rc)
Do
DoEvents
Call SetCursorPos(rc.Left, rc.Top)
Call Sleep(200)
Call SetCursorPos(rc.Right, rc.Top)
Call Sleep(200)
Call SetCursorPos(rc.Right, rc.Bottom)
Call Sleep(200)
Call SetCursorPos(rc.Left, rc.Bottom)
Call Sleep(200)
Loop
done:

End Sub

--
keepITcool

www.XLsupport.com | keepITcool chello nl | amsterdam





Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
Rectangle Symbol cs_jono Excel Discussion (Misc queries) 3 April 25th 08 09:29 PM
Rectangle Box Keyrookie Excel Worksheet Functions 1 January 27th 08 08:09 AM
Confining a point in a rectangle [email protected] Excel Discussion (Misc queries) 1 May 24th 07 01:03 AM
Resizeable Rectangle Bill Bell Excel Programming 1 October 27th 03 08:34 PM
Add text to a rectangle in VBA pk Excel Programming 2 October 19th 03 02:44 AM


All times are GMT +1. The time now is 09:20 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright ©2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"