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

 

[Jaafar Tribak]

Hi Charllie,

I am not sure but I find the following approach much easier to follow than that of cPearson because it uses APIs to convert Cell measurements to Screen mesurments.

Place the following code in a Standard Module and assign the FormPositioner_Test Procedure to a Button on your worksheet :

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
Public PosCell 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


Public 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 FormPositioner_Test()

    '\\\Ignore Error in case there is no TestForm
    On Error Resume Next
    With ThisWorkbook.VBProject
        .VBComponents.Remove .VBComponents("TestForm")
    End With
    Err.Clear
TryAgain:
    '\\\Prompt the user for a Cell selection
    Set PosCell = Application.InputBox _
    ("Select a Cell with the Mouse     or " & vbCrLf & _
    "Type a Cell Address in the Field below", _
    "Form Positioner", Type:=8)
    If Err.Number <> 0 Then
        '\\\You cancelled
        Exit Sub
    End If
    If Intersect(ActiveWindow.VisibleRange, PosCell) Is Nothing Then
        MsgBox "Cell must be visible !   " & vbCrLf & "Try again ", vbCritical
        GoTo TryAgain
    End If
    On Error GoTo 0
    '\\\Create Form
    Set objForm = ThisWorkbook.VBProject.VBComponents.Add(3) 'Form
    '\\\Save WB to take effect
    ThisWorkbook.Save
    objForm.Name = "TestForm"
    '\\\define Form Pos upon Initializing
    strCode = "Private Sub UserForm_Initialize()" & vbCrLf
    strCode = strCode & "  With Me" & vbCrLf
    strCode = strCode & "  .StartUpPosition=0 " & vbCrLf
    strCode = strCode & "   .left = TopLeftPoint(PosCell).x " & vbCrLf
    strCode = strCode & "   .top = TopLeftPoint(PosCell).y " & vbCrLf
    strCode = strCode & "  End With " & vbCrLf
    strCode = strCode & "end sub"
    objForm.CodeModule.AddFromString strCode
    VBA.UserForms.Add(objForm.Name).Show
    '\\\Clean Up
    ThisWorkbook.VBProject.VBComponents.Remove objForm
    Set objForm = Nothing
    Set PosCell = Nothing

End Sub

Now, just Click on your added Button, select a Cell on the Worksheet, click Ok and the UserForm will be created on the fly and will be positioned exactly over the Cell you chose .

Let me know if any probs.

Regards.

 

[charllie]

Hi Jaafar

Thank you very much for your code and help, as you say the method seems to be a lot easy. However i am having difficulty in getting it to work with my choosen userform.

I have input the code into a new module which i named form_positioner, created a new button from the form toolbar on my worksheet and assigned the form_positioner sub to it.

When i activate the button the form_positioner box appears asking me to select a cell. I do this and select "OK". Once this is done it creates a new useform in the position i choose and appears in my workbook. Each time i try it it creates a new userform.

I know i have to tell it what userform to open but not sure where.

I your code where it states "TestForm", i have tried replacing these with my userform "JOb_Space" however nothing happens. At one point i had an error message saying that it could not find the object.

Sorry if i appear a bit thick on this but i have tried everything i think is right.

Thanks

 

[Norie]

Charllie

What you actually need to do is put code in the initialize event of your userform.

Jaafar is adding code to the newly created form here.

strCode = "Private Sub UserForm_Initialize()" & vbCrLf 
    strCode = strCode & "  With Me" & vbCrLf 
    strCode = strCode & "  .StartUpPosition=0 " & vbCrLf 
    strCode = strCode & "   .left = TopLeftPoint(PosCell).x " & vbCrLf 
    strCode = strCode & "   .top = TopLeftPoint(PosCell).y " & vbCrLf 
    strCode = strCode & "  End With " & vbCrLf 
    strCode = strCode & "end sub"

You need to extract the code from that.

Private Sub UserForm_Initialize()
With Me 
  .StartUpPosition=0
  .Left = TopLeftPoint(PosCell).X 
  .Top = TopLeftPoint(PosCell).Y
End With 
End Sub

 

[charllie]

Hi Again,

I see what you mean and i extracted the part:

Private Sub UserForm_Initialize() 
With Me 
  .StartUpPosition=0 
  .Left = TopLeftPoint(PosCell).X 
  .Top = TopLeftPoint(PosCell).Y 
End With 
End Sub

From the Jaafars newly created userform and placed it into the form i want it to work on. However nothing happened. I also tried extracting it from the module also (after i had created new userform) but again nothing.

Am i right in thinking that the startup position details etd should change to show the position. i noticed that in the newly created userform and the module, they are the same no matter where you put them.

Whenever i try to use the newly created userform it places it in the centre as per usual excel position.

Thanks

 

[Norie]

You'll need this as well.

TryAgain: 
    '\\\Prompt the user for a Cell selection 
    Set PosCell = Application.InputBox _ 
    ("Select a Cell with the Mouse     or " & vbCrLf & _ 
    "Type a Cell Address in the Field below", _ 
    "Form Positioner", Type:=8) 
    If Err.Number <> 0 Then 
        '\\\You cancelled 
        Exit Sub 
    End If 
    If Intersect(ActiveWindow.VisibleRange, PosCell) Is Nothing Then 
        MsgBox "Cell must be visible !   " & vbCrLf & "Try again ", vbCritical 
        GoTo TryAgain 
    End If

 

[Jaafar Tribak]

Sorry Charllie for the inconvinience....The code I posted was just a Demo and obviously needs some tweaking to meet your specific needs.

Norie, thanks for your interest in helping with this .

Below is a version of the above code that position UserForm1 which is assumed to be the name of an existing Form in your Project.

Place in a Standard Module:

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
Public PosCell 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




Public 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, objPostCell As Range)

    With objFrm
        .startupposition = 0
        .Left = TopLeftPoint(PosCell).x
        .Top = TopLeftPoint(PosCell).Y
        .Show
    End With

End Sub




Sub FormPositioner_Test2()

On Error Resume Next
TryAgain:
    '\\\Prompt the user for a Cell selection
    Set PosCell = Application.InputBox _
    ("Select a Cell with the Mouse     or " & vbCrLf & _
    "Type a Cell Address in the Field below", _
    "Form Positioner", Type:=8)
    If Err.Number <> 0 Then
        '\\\You cancelled
        Exit Sub
    End If
        If Intersect(ActiveWindow.VisibleRange, PosCell) Is Nothing Then
        MsgBox "Cell must be visible !   " & vbCrLf & "Try again ", vbCritical
        GoTo TryAgain
    End If
    PositionForm UserForm1, PosCell
    
End Sub

Just run the Procedure named FormPositioner_Test2 and see if it is OK.

Regards.

 

[charllie]

Hi Jaafar,

How are you today?

I followed your instructions, placed the code into a standard module, changed the userform1 to the name of my form (Job_Space) and run it.

It worked first time and put my userform in the position that i wanted. What do i need to do now to ensure that the form appears in same place everytime. Once i closed and then re-opened it, it appeared back in the centre again. Do i need to copy any code into the userforms coding at all?

Also, what is the setting required for the userforms startupposition? Mine is on 0-Manual.

Norie, Thankyou for your help, i appreciate it.

Thanks

 

[Jaafar Tribak]

Hi Charllie,

I am not sure what the problem may be but it could be that you have some code in the WorkBook_Open or UserForm_initialize events which could be interfering with the flow of the posted code.

See if that helps.

Regards.

 

[Norie]

Jaafar

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

I'm not sure, and I don't really have time to adapt your code to do so.