Consulting

Results 1 to 11 of 11

Thread: Position modeless userform to top right of Activewindow

  1. #1
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,728
    Location

    Position modeless userform to top right of Activewindow

    Working on a 'Wizard' form (below is just some test code as a proof of concept)

    I'd like the modeless UF to align top right of the active pane, but can't get the .Top's and .Left's and .Width's to work out reliably in the UserForm_Activate

    The screen shot show what I'm trying to achieve (it was manually positioned since I can't get the code the right)

    I'd like to set the height to the same as the ActiveWindow also


    Option ExplicitPrivate Sub CommandButton1_Click()
        ActiveSheet.Range("A1").Value = Format(Now, "long date") & " - " & Format(Now, "long time")
    End Sub
    Private Sub CommandButton2_Click()
        Load ufData
        ufData.Show (vbModal)
    End Sub
    Private Sub CommandButton3_Click()
        ActiveSheet.Range("A2").Value = 123
    End Sub
    Private Sub CommandButton4_Click()
        Me.Hide
        Unload Me
    End Sub
    Private Sub UserForm_Activate()
        Me.StartUpPosition = 0
        Me.Top = -Application.Top - ActiveWindow.Top
        Me.Left = -ActiveWindow.Left + ActiveWindow.Width - Me.Width
    End Sub

    Paul
    Attached Images Attached Images

  2. #2
    VBAX Contributor
    Joined
    Oct 2012
    Location
    Brisbane, Queensland, Australia
    Posts
    163
    Location
    I am not sure that there is anyway of determining what values to use to get the form to open in that position.

    You could put a temporary command button on the form that runs the following code and then position the form where you want it and click on that button and record the values and then use them in the Activate Event.

    MsgBox Me.Top
    MsgBox Me.Left
    Of course that won't be of much use if you are creating a wizard that will be used by various users of various machines.

    You might also take a look at the following page Chip Pearson's website:

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

    Another approach would be to give the use instructions to drag the form to the position that they desire and then have one of your command buttons write the Top and Left values to the Registry using SaveSetting and have a GetSetting routine in the userform Activate to get the Top and Left values from the registry and use them thereafter to automatically position the form.

  3. #3
    Knowledge Base Approver VBAX Wizard
    Joined
    Apr 2012
    Posts
    5,645
    I managed with

    Private Sub UserForm_Initialize()
        startupposition = 0
        Application.WindowState = xlMaximized
        Top = Application.Height * 0.11
        Left = (Application.Width - Width) * 0.97
        
    '    Application.Windows(1).DisplayVerticalScrollBar
    '    Application.Windows(1).DisplayRuler
    '    Application.Windows(1).DisplayHeadings
    '    Application.DisplayFormulaBar
    End Sub
    But I think it's also dependent of the verticalscrollbar, the ruler, the display of headings and the formulabar.

    Nor the properties of application.windows(1), nor those of Application.windows(1).activepane were helpful

  4. #4
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,728
    Location
    @Doug -- I had looked at Chip's also and that will position the UF based on a cell, which wouldn't work to have something that would look like a task pane

    @snb -- you're right about many of the display-oriented properies not being helpful. I'm reluctant to hard code fudge factors (0.11, 0.97, etc.) since on a different machine, the UF could be only partially displayed, or might cover up something else

    Back to the drawing board.

    I might have to go with a 'Wizard' tab on the ribbon which would not be as user friendly as the modeless userform approach, but might be the most flexible way

    Paul

  5. #5
    VBAX Master Aflatoon's Avatar
    Joined
    Sep 2009
    Location
    UK
    Posts
    1,720
    Location
    This should always appear below the formula bar (if shown, or Ribbon if not). The -10 is to allow for window borders, though you could probably get that information from the registry if necessary!
    [vba]
    Option Explicit
    Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" _
    (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long

    'API's for getting the factors to convert points to pixels
    Private Declare Function GetDC Lib "user32" ( _
    ByVal hWnd As Long) As Long


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


    Private Declare Function ReleaseDC Lib "user32" ( _
    ByVal hWnd As Long, _
    ByVal hdc As Long) As Long

    Private Declare Function GetWindowRect Lib "user32.dll" ( _
    ByVal hWnd As Long, lpRect As RECT) As Long
    Private Type RECT
    left As Long
    top As Long
    right As Long
    bottom As Long
    End Type
    Private Const LOGPIXELSY = 90

    'The width of a Y pixel in Excel's userform coordinates
    Private Function PointsPerPixelY() As Double
    Dim hdc As Long
    hdc = GetDC(0)
    PointsPerPixelY = 72 / GetDeviceCaps(hdc, LOGPIXELSY)
    ReleaseDC 0, hdc
    End Function

    Private Sub UserForm_Activate()
    Dim rectBk As RECT
    Dim hWndBk As Long
    hWndBk = GetWorkbookHandle(ActiveWorkbook.Name)
    GetWindowRect hWndBk, rectBk
    Me.top = rectBk.top * PointsPerPixelY
    Me.left = Application.left + Application.Width - Me.Width - 10
    Me.Height = (rectBk.bottom - rectBk.top) * PointsPerPixelY
    End Sub

    Function GetWorkbookHandle(strWBCaption As String, Optional lngHWnd As Long) As Long
    Dim hWnd As Long, hWndDesk As Long
    Dim strText As String
    If lngHWnd = 0 Then lngHWnd = Application.hWnd
    hWndDesk = FindWindowEx(lngHWnd, 0&, "XLDESK", vbNullString)
    If hWndDesk <> 0 Then
    hWnd = FindWindowEx(hWndDesk, hWnd, "EXCEL7", strWBCaption)
    If hWnd <> 0 Then GetWorkbookHandle = hWnd
    End If
    End Function

    [/vba]
    Be as you wish to seem

  6. #6
    You could of course tile the userform next to the application window (so Excel resizes), a bit like this screenshot.
    Attached Images Attached Images
    Regards,

    Jan Karel Pieterse
    Excel MVP jkp-ads.com

  7. #7
    VBAX Guru Kenneth Hobs's Avatar
    Joined
    Nov 2005
    Location
    Tecumseh, OK
    Posts
    4,956
    Location
    I did it similar to Aflatoon's code but with some assumptions.

    In a Module:
    Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
      (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" _
      (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
    Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
    
     'API's for getting the factors to convert points to pixels
    Private Declare Function GetDC Lib "user32" ( _
    ByVal hwnd As Long) As Long
     
    Private Declare Function GetDeviceCaps Lib "gdi32" ( _
    ByVal hdc As Long, _
    ByVal nIndex As Long) As Long
     
    Private Declare Function ReleaseDC Lib "user32" ( _
    ByVal hwnd As Long, _
    ByVal hdc As Long) As Long
     
    Public Type RECT
      Left As Long
      Top As Long
      Right As Long
      Bottom As Long
    End Type
    
    Private Const LOGPIXELSY = 90
     
     'The width of a Y pixel in Excel's userform coordinates
    Public Function PointsPerPixelY() As Double
        Dim hdc                   As Long
        hdc = GetDC(0)
        PointsPerPixelY = 72 / GetDeviceCaps(hdc, LOGPIXELSY)
        ReleaseDC 0, hdc
    End Function
    
    Function RectVScrollBar() As RECT
      Dim xlmain As Long, xldesk As Long, excel As Long
      Dim nuiscrollbar As Long, netuihwnd As Long
      xlmain = FindWindow("xlmain", vbNullString)
      xldesk = FindWindowEx(xlmain, 0&, "xldesk", vbNullString)
      excel = FindWindowEx(xldesk, 0&, "excel7", vbNullString)
      nuiscrollbar = FindWindowEx(excel, 0&, "nuiscrollbar", vbNullString)
      netuihwnd = FindWindowEx(nuiscrollbar, 0&, "netuihwnd", vbNullString)
      Dim TheRect As RECT
      ' size and position values stored in rect
      GetWindowRect netuihwnd, TheRect
      RectVScrollBar = TheRect
    End Function
    
    Function HBar() As RECT
      Dim xlmain As Long, excelh As Long
      xlmain = FindWindow("xlmain", vbNullString)
      excelh = FindWindowEx(xlmain, 0&, "excelh", vbNullString)
      Dim TheRect As RECT
      ' size and position values stored in rect
      GetWindowRect excelh, TheRect
      HBar = TheRect
    End Function
    In the Userform2 or change the name Userform2 to your Userform's name:
    Private Sub UserForm_Activate()
      Dim vsbar As RECT
      vsbar = RectVScrollBar
      
      With UserForm2
        .Left = vsbar.Left * PointsPerPixelY - .Width
        .Top = HBar.Bottom * PointsPerPixelY
      End With
    End Sub

  8. #8
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,728
    Location
    Quote Originally Posted by Jan Karel Pieterse View Post
    You could of course tile the userform next to the application window (so Excel resizes), a bit like this screenshot.
    @JKP --Can you tile a userfrom like that using VBA? If so, could you post a sample please?

    @KH and Aflatoons -- Graduate level stuff. I'll have to experiment, but it looks like it's much closer to a solution than what I came up with

    Paul

  9. #9
    Yes of course you can. I'll try to dig up an example tomorrow.
    Regards,

    Jan Karel Pieterse
    Excel MVP jkp-ads.com

  10. #10
    Please find attached a demo. Note that this only works when the form is shown modeless, if not, you have to do the tiling before actually showing the form.
    Attached Files Attached Files
    Regards,

    Jan Karel Pieterse
    Excel MVP jkp-ads.com

  11. #11
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,728
    Location
    @JKP -- thanks for the example

    @KH -- thanks for the PM and the other API insights


    So many choices, but it's much better than not having any choices at all for sure

    Now all I have to do is come up with the Wizard

    Paul

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •