Freeze userform position relative to worksheet

[tbrock]

Hello all,

I have a spreadsheet (Windows 32-bit, Excel 2007) in which I have a userform successfully being placed where I want it (top left of cell B1).

But the userform remains fixed in its initial position when I reposition the spreadsheet.

I would like the userform to move with the spreadsheet as if it is welded to its initial startup position. So I would always be able to see what I see in the first photo regardless of where on the screen Excel is.

I have looked high and low - after a few hours, I was frustrated/determined enough to scroll thru all the pages here at Mr. Excel that came up in search. So far nothing for what I hope (and believe) is a trivial problem. Can some kind soul prove me correct?

Thank you,
Tom

 

[Legacy 456155]

To the best of my knowledge, what you are trying to do is not at all trivial, though I would not mind being wrong about that.
I have some old code that anchors old-school command-bars (a windowed control) to specific places in a worksheet. The code could likely be adapted to user forms. Let me know if you are interested and I'll dig it up.

 

[tbrock]

@ Dataluver, Silly me, I was thinking it would be something as simple as putting code into a (workbook) event that fired upon moving said workbook where I could get the new location of the workbook (or perhaps of the "parent" cell I use for the initial positioning). However, I do not see any event that is the obvious target.

I'd love to see what you came up with to see if I can adapt it!

 

[Logit]

.
Resource link : How do I align a UserForm next to the active cell?

[B]Sheet code[/B]

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    UserForm1.Show
End Sub


[B]Userform code[/B]

Private Sub UserForm_Initialize()
  Dim pointcoordinates As pointcoordinatestype, horizontaloffsetinpoints As Double, verticaloffsetinpoints As Double
    With Me
        horizontaloffsetinpoints = (.Width - .InsideWidth) / 2
        verticaloffsetinpoints = 1
        Call GetPointCoordinates(ActiveCell, pointcoordinates)
        .StartUpPosition = 0
        .Top = pointcoordinates.Top - verticaloffsetinpoints
        .Left = pointcoordinates.Left - horizontaloffsetinpoints
    End With
End Sub


[B]Module code[/B]

Private Const LOGPIXELSX = 88
Private Const LOGPIXELSY = 90
Public Type pointcoordinatestype
    Left As Double
    Top As Double
    Right As Double
    Bottom As Double
End Type
Private pixelsperinchx As Long, pixelsperinchy As Long, pointsperinch As Long, zoomratio As Double
#If VBA7 And Win64 Then
    Private Declare PtrSafe Function GetDeviceCaps Lib "gdi32" (ByVal hdc As LongPtr, ByVal nIndex As Long) As Long
    Private Declare PtrSafe Function GetDC Lib "user32" (ByVal hwnd As LongPtr) As LongPtr
    Private Declare PtrSafe Function ReleaseDC Lib "user32" (ByVal hwnd As LongPtr, ByVal hdc As LongPtr) As Long
#Else
    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
#End If

Private Sub ConvertUnits()
  Dim hdc As LongPtr
    hdc = GetDC(0)
    pixelsperinchx = GetDeviceCaps(hdc, LOGPIXELSX) ' Usually 96
    pixelsperinchy = GetDeviceCaps(hdc, LOGPIXELSY) ' Usually 96
    ReleaseDC 0, hdc
    pointsperinch = Application.InchesToPoints(1)   ' Usually 72
    zoomratio = ActiveWindow.Zoom / 100
End Sub

Private Function PixelsToPointsX(ByVal pixels As Long) As Double
    PixelsToPointsX = pixels / pixelsperinchx * pointsperinch
End Function

Private Function PixelsToPointsY(ByVal pixels As Long) As Double
    PixelsToPointsY = pixels / pixelsperinchy * pointsperinch
End Function

Private Function PointsToPixelsX(ByVal points As Double) As Long
    PointsToPixelsX = points / pointsperinch * pixelsperinchx
End Function

Private Function PointsToPixelsY(ByVal points As Double) As Long
    PointsToPixelsY = points / pointsperinch * pixelsperinchy
End Function

Public Sub GetPointCoordinates(ByVal cellrange As Range, ByRef pointcoordinates As pointcoordinatestype)
  Dim i As Long
    ConvertUnits
    Set cellrange = cellrange.MergeArea
    For i = 1 To ActiveWindow.Panes.Count
        If Not Intersect(cellrange, ActiveWindow.Panes(i).VisibleRange) Is Nothing Then
            pointcoordinates.Left = PixelsToPointsX(ActiveWindow.Panes(i).PointsToScreenPixelsX(cellrange.Left))
            pointcoordinates.Top = PixelsToPointsY(ActiveWindow.Panes(i).PointsToScreenPixelsY(cellrange.Top))
            pointcoordinates.Right = pointcoordinates.Left + cellrange.Width * zoomratio
            pointcoordinates.Bottom = pointcoordinates.Top + cellrange.Height * zoomratio
            Exit Sub
        End If
    Next
End Sub

 

[tbrock]

@ Logit. Thanks for the post.

I actually had found this and am currently using it. It does a great job of positioning the form initially as shown in my first screenshot. But unless I have managed to break something, it anchors the form to that spot on the screen and so when I move the spreadsheet (or maximize it), I get something like the second screenshot.

 

[Logit]

.
Ok ... I just tested this from CPearson and it works if you choose CHILD OF DESKTOP. You can position the form the first time, then it will remain where you placed it,
relative to the cells no matter if you scroll the sheet or move the entire workbook.

Resource URL : Pearson Software Consulting

Download example workbook : http://www.cpearson.com/Zips/SetParent.zip

 

[tbrock]

Wow! Thank you for the effort, Logit! I will take a look at that tomorrow. My brain is pretty fried right now, time to call it a night.

 

[Logit]

K

 

[Legacy 456155]

Hi Tom. I wonder if you could adapt Logit's example using the Workbook_WindowResize event? It might work. Let me know.

 

[Legacy 456155]

Well, I went ahead and tried it and it works if you resize the window in any way. However, there are not any events TIKO to trap moving the window or scrolling the worksheet (if that even applies to you). You might also need to check if the range you are using for an anchor is visible. Let me know if this will do.

WorkBook Class:

Private Sub Workbook_WindowResize(ByVal Wn As Window)
    UserForms(0).SetPos
End Sub

Userform:

Private Sub UserForm_Initialize()
    SetPos
End Sub

Public Sub SetPos()
    Dim pointcoordinates As pointcoordinatestype, horizontaloffsetinpoints As Double, verticaloffsetinpoints As Double
    With Me
        horizontaloffsetinpoints = (.Width - .InsideWidth) / 2
        verticaloffsetinpoints = 1
        Call GetPointCoordinates(ActiveCell, pointcoordinates)
        .StartUpPosition = 0
        .Top = pointcoordinates.Top - verticaloffsetinpoints
        .Left = pointcoordinates.Left - horizontaloffsetinpoints
    End With
End Sub

Module code unchanged.