Code to get a Range RECTangle or PT

[keepITcool]

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

 

[Vic Eldridge]

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/m...ogramming/browse_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]

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 :

 

[Giovanni D via OfficeKB.com]

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....

 

[keepITcool]

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 :

 

[Vasant Nanavati]

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

 

[keepITcool]

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 :