Position Form on screen v Window Zoom !

[Guest]

Hi,

This is a code from KeepItCool which works fine only when the Zoom is 100.
Any Idea how I can adapt this code so it works regrdless of the current Zoom ?

What the code does is position the UserForm over the Second Row\ Second
Column of the current Visible Range.


Code:

Private Declare Function GetDC Lib "user32.dll" ( _
ByVal hwnd&) As Long
Private Declare Function ReleaseDC Lib "user32.dll" ( _
ByVal hwnd&, ByVal hDC&) As Long
Private Declare Function GetDeviceCaps Lib "gdi32" ( _
ByVal hDC&, ByVal nIndex&) As Long
Function ScreenRes&(iDir%)
Dim lDC&
Static res
If Not IsArray(res) Then
ReDim res(1) As Long
lDC = GetDC(0)
res(0) = GetDeviceCaps(lDC, 88&)
res(1) = GetDeviceCaps(lDC, 90&)
lDC = ReleaseDC(0, lDC)
End If
ScreenRes = res(iDir)
End Function

Private Sub UserForm_Activate()

'position on row2,col2 of visible range
With ActiveWindow
Me.Top = .PointsToScreenPixelsY(.VisibleRange.Rows( _
2).Top * ScreenRes(0) / 72) * 72 / ScreenRes(0)
Me.Left = .PointsToScreenPixelsX(.VisibleRange.Columns( _
2).Left * ScreenRes(1) / 72) * 72 / ScreenRes(1)
End With

End Sub


I have tried finding a solution but no luck so far.

Any help much appreciated.

Regards.

 

[keepITcool]

What's so hard with this?
Just adjust for the zoom..

Private Sub UserForm_Activate()

'position on row2,col2 of visible range
With ActiveWindow
Me.Top = .PointsToScreenPixelsY( _
.VisibleRange.Rows(2).Top _
* .Zoom / 100 * ScreenRes(0) / 72) * 72 / ScreenRes(0)
Me.Left = .PointsToScreenPixelsX( _
.VisibleRange.Columns(2).Left _
* .Zoom / 100 * ScreenRes(1) / 72) * 72 / ScreenRes(1)
End With

End Sub





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


RAFAAJ2000 wrote :

 

[okaizawa]

Hi,

I am not sure if this could work always...

Private Declare Function GetDeviceCaps Lib "gdi32" ( _
ByVal hdc As Long, ByVal nIndex As Long) As Long
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 Const LOGPIXELSX = 88
Private Const LOGPIXELSY = 90

Sub SetPos(r As Range)
Dim ws As Worksheet
Dim hdc As Long
Dim px As Long, py As Long
Dim x As Double, y As Double
Dim i As Long, z As Long

Set ws = r.Worksheet

hdc = GetDC(0)
px = GetDeviceCaps(hdc, LOGPIXELSX)
py = GetDeviceCaps(hdc, LOGPIXELSY)
ReleaseDC 0, hdc

z = ActiveWindow.Zoom

x = ActiveWindow.PointsToScreenPixelsX(0)
For i = 1 To r.Column - 1
x = x + Int(ws.Columns(i).Width * px * z / 7200 + 0.5000001)
Next

y = ActiveWindow.PointsToScreenPixelsY(0)
For i = 1 To r.Row - 1
y = y + Int(ws.Rows(i).Height * py * z / 7200 + 0.5000001)
Next

Me.Left = x * 72 / px
Me.Top = y * 72 / py
End Sub


Private Sub UserForm_Activate()
SetFormPos ActiveWindow.VisibleRange(2, 2)
End Sub

 

[okaizawa]

sorry for my mistake.

Sub SetPos(r As Range)

Sub SetFormPos(r As Range)
is correct.