Help With Form Positioner

[charllie]

Hi Folks,

I got the link below from previous posts people made here but having some difficulties.

http://www.cpearson.com/excel/FormPosition.htm

The link explains how to position your userform in a position of your choice.

I have downloaded and imported the file, amended it to suit my userform but don't understand it fully.

Can someone explain to me how you input the positions so you can get it to your position choice. I apologise if i appear thick but i have read the instruction and the code but cant figure it out.

My feeling tells me that i have to input the figures to place it in the position but i don't understand where.

I have used sample one i downloaded and still don't get it.

Would really appreciate some guidance here please.

Thanks

 

[charllie]

Hi Guys,

I think that charllie wants a userform to be positioned at a particular cell whenever it opens.

Yes, that is what i want to happen Jaafar. Is it possible to do that with this code?

Thanks

 

[Jaafar Tribak]

Charllie,

In this take, I assume you want to display the Top Left of the Form ALWAYS at Cell C4.If you want to change this just amend the line : Set objCell = Range("C4") '\\ Change as required located in the DisplayForm() Procedure as needed.

Place this in a Standard Module and run the DisplayForm() Procedure :

Option Explicit

Declare Function GetDeviceCaps Lib "gdi32" ( _
ByVal hDC As Long, ByVal nIndex As Long) As Long

Declare Function GetDC Lib "user32" ( _
ByVal hwnd As Long) As Long

Declare Function ReleaseDC Lib "user32" ( _
ByVal hwnd As Long, ByVal hDC As Long) As Long
  
Type POINTAPI
    x As Long
    Y As Long
End Type

Const LOGPIXELSX As Long = 88
Const LOGPIXELSY As Long = 90
Const PointsPerInch = 72

Dim objForm As Object
Dim strCode As String
Dim objPosCell As Range
Dim PixelsPerPointX As Double
Dim PixelsPerPointY As Double
Dim PointsPerPixelX As Double
Dim PointsPerPixelY As Double
Dim lnghDC As Long
Dim lngCurrentZoom As Double


Function TopLeftPoint(Rng As Range) As POINTAPI
    '\\\ Converts Points to Screen Pixels
    lnghDC = GetDC(0)
    PixelsPerPointX = GetDeviceCaps(lnghDC, LOGPIXELSX) / PointsPerInch
    PointsPerPixelX = PointsPerInch / GetDeviceCaps(lnghDC, LOGPIXELSX)
    PixelsPerPointY = GetDeviceCaps(lnghDC, LOGPIXELSY) / PointsPerInch
    PointsPerPixelY = PointsPerInch / GetDeviceCaps(lnghDC, LOGPIXELSY)
    With TopLeftPoint
        .x = ActiveWindow.PointsToScreenPixelsX(Rng.Left * _
        (PixelsPerPointX * (ActiveWindow.Zoom / 100))) * PointsPerPixelX
 
        .Y = ActiveWindow.PointsToScreenPixelsY(Rng.Top * _
        (PixelsPerPointY * (ActiveWindow.Zoom / 100))) * PointsPerPixelY
    End With
    ReleaseDC 0, lnghDC
End Function


Sub PositionForm(objFrm As Object, objPosCell As Range)
    With objFrm
        .startupposition = 0
        .Left = TopLeftPoint(objPosCell).x
        .Top = TopLeftPoint(objPosCell).Y
    End With
End Sub


Sub DisplayForm()
    Dim objCell As Range
    Dim objForm As Object
    Set objCell = Range("C4") '\\ Change as required
    Set objForm = UserForm1  '\\ Change as required
    '\\ Make sure topleft Cell is visible otherwise leave
    If Intersect(ActiveWindow.VisibleRange, objCell) Is Nothing Then
            MsgBox "Cell " & objCell.Address & " Is not Visible !   " _
            & vbCrLf & "Bring it to view and try again ", vbCritical
            Exit Sub
    End If
    ' \\ Position and display the Form
    PositionForm objForm, objCell
    objForm.Show
End Sub

If you need to display the Form in relation to a certain location in the Visible Range instead of a particular Cell then let us know & we will try to adapt the code.

Regards.

 

[charllie]

Hi Jaafar,

Well that is absolutly brilliant and a very usefull piece of code.

I searched the internet high and low for a code like this and couldn't find one so a lot of people will want to use this i am sure.

I managed to organise the positions of 3 forms so far in one workbook.

Jaafar. thank you very much for your help and time, i really appreciate it.

Thanks